home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / unix / volume26 / veos-2.0 / part03 < prev    next >
Encoding:
Text File  |  1993-04-25  |  92.5 KB  |  3,162 lines

  1. Newsgroups: comp.sources.unix
  2. From: voodoo@hitl.washington.edu (Geoffery Coco)
  3. Subject: v26i186: veos-2.0 - The Virtual Environment Operating Shell, V2.0, Part03/16
  4. Sender: unix-sources-moderator@vix.com
  5. Approved: paul@vix.com
  6.  
  7. Submitted-By: voodoo@hitl.washington.edu (Geoffery Coco)
  8. Posting-Number: Volume 26, Issue 186
  9. Archive-Name: veos-2.0/part03
  10.  
  11. #! /bin/sh
  12. # This is a shell archive.  Remove anything before this line, then unpack
  13. # it by saving it into a file and typing "sh file".  To overwrite existing
  14. # files, type "sh file -c".  You can also feed this as standard input via
  15. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  16. # will see the following message at the end:
  17. #        "End of archive 3 (of 16)."
  18. # Contents:  kernel_private/makefile kernel_private/src/fern/fgod.lsp
  19. #   kernel_private/src/include/world.h kernel_private/src/talk/shmem.c
  20. #   src/include/world.h src/kernel_current/fern/fgod.lsp
  21. #   src/kernel_current/include/world.h src/kernel_current/talk/shmem.c
  22. #   src/xlisp/xcore/c/ChangeLog src/xlisp/xcore/c/xldmem.h
  23. # Wrapped by vixie@efficacy.home.vix.com on Sun Apr 25 23:10:33 1993
  24. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  25. if test -f 'kernel_private/makefile' -a "${1}" != "-c" ; then 
  26.   echo shar: Will not clobber existing file \"'kernel_private/makefile'\"
  27. else
  28. echo shar: Extracting \"'kernel_private/makefile'\" \(7306 characters\)
  29. sed "s/^X//" >'kernel_private/makefile' <<'END_OF_FILE'
  30. X# *****************************************************************************
  31. X#
  32. X# VEOS 2.0 Copyright (C) 1992 Geoffrey P. Coco,
  33. X# Human Interface Technology Laboratory
  34. X#                                             
  35. X# This program is free software; you use it under the terms of the
  36. X# VEOS LICENSE which can be found the in root of the veos directory tree.
  37. X#                                             
  38. X# *****************************************************************************
  39. X
  40. X
  41. X#------------------------------------------------------------------------------
  42. X#
  43. X#  VEOS makefile methodology:
  44. X#
  45. X#  $(HOME) is the root veos directory.
  46. X#  It contains all accociated source, libraries, executables and documents.
  47. X#
  48. X#  $(HOME)lib/ contains public libraries for the veos kernel, xlisp, etc..
  49. X#  $(HOME)bin/ contains public executables, like entity, testshell and xlisp.
  50. X#  $(HOME)src/ contains public source for drivers, veos kernel, fern, etc..
  51. X#
  52. X#  $(HOME)kernel_private/ is the directory reserved for the site
  53. X#  administrator of veos.  This is where all veos build commands should
  54. X#  be issued.  Build commands are performed by this makefile
  55. X#
  56. X#  Notice that kernel_private/ contains the original source tree for the
  57. X#  veos kernel and fern.  When building a stable version of veos, use the
  58. X#  'make public' option.  This command will also copy the private source
  59. X#  and libraries to public directories $(PUB_SRC_DIR).  Veos users should
  60. X#  always link with public versions of libraries and inspect public
  61. X#  versions of the code.
  62. X#
  63. X#------------------------------------------------------------------------------
  64. X
  65. XHOME = /home/voodoo/veos/
  66. XCOMMAND_DIR = ${HOME}kernel_private/
  67. X
  68. XLISP_INCLUDE_DIR = ${HOME}src/xlisp/xcore/c/
  69. XVEOS_INCLUDE_DIR = $(COMMAND_DIR)src/include/
  70. XVEOS_INCLUDE_DIRS = -I${VEOS_INCLUDE_DIR} -I${LISP_INCLUDE_DIR}
  71. XPUB_INCLUDE_DIR = ${HOME}src/include/
  72. X
  73. XNANCY_SRC_DIR = $(COMMAND_DIR)src/nancy/
  74. XSHELL_SRC_DIR = $(COMMAND_DIR)src/shell/
  75. XINET_SOCK_SRC_DIR = $(COMMAND_DIR)src/talk/
  76. XFERN_SRC_DIR  = $(COMMAND_DIR)src/fern/
  77. XPUB_SRC_DIR = ${HOME}src/kernel_current/
  78. X
  79. XLIB_DIR = $(COMMAND_DIR)lib/
  80. XPUB_LIB_DIR = ${HOME}lib/
  81. X
  82. XPUB_EXEC_DIR = ${HOME}bin/
  83. XEXEC_DIR = $(COMMAND_DIR)bin/
  84. X
  85. XKINCLUDES = ${VEOS_INCLUDE_DIR}kernel.h \
  86. X        ${VEOS_INCLUDE_DIR}world.h  \
  87. X
  88. X#------------------------------------------------------------------------------
  89. X
  90. Xinclude $(HOME)src/machine_specific.mk
  91. X
  92. X# The machine specific file must define the following macros:
  93. X# 
  94. X#   CC =
  95. X#       The c compiler and associated options.
  96. X#       Things to include here are options for debugging,
  97. X#       optimization, include directories, veos machine specific
  98. X#       flags.  VEOS 2.0 currently knows about -D_SG_ for Silicon
  99. X#       Graphics, -D_DEC_ for DECStations, and -D_SUN for Sun.
  100. X#       Do NOT use -c in this macro.
  101. X# 
  102. X#   AR = 
  103. X#       The library archive command and flags.
  104. X#       Usually 'ar rcv' is sufficient
  105. X# 
  106. X#   UPDATE_LIB = 
  107. X#       What to do to a library after it has been archived.
  108. X#       Usually: ranlib or touch.
  109. X# 
  110. X#   ASSOC_LIBS =
  111. X#       These are extra libraries which get bound in a basic entity.
  112. X#       The libraries for xlisp, the veos kernel, and xlisp/veos
  113. X#       utitilities are automatically bound to the entity and do not
  114. X#       need to be mentioned here.
  115. X#
  116. X#------------------------------------------------------------------------------
  117. X
  118. Xclean:
  119. X    - /bin/rm -f $(SHELL_SRC_DIR)*.o
  120. X    - /bin/rm -f $(INET_SOCK_SRC_DIR)*.o
  121. X    - /bin/rm -f $(NANCY_SRC_DIR)*.o
  122. X    - /bin/rm -f $(LIB_DIR)libkernel_proto.a
  123. X    - /bin/rm -f $(LIB_DIR)libxvnative_glue_proto.a
  124. X    - /bin/rm -f $(FERN_SRC_DIR)*.o
  125. X    - /bin/rm -f $(LIB_DIR)libfern.a
  126. X
  127. X#------------------------------------------------------------------------------
  128. X
  129. Xpublic: entity public_kernel public_fern
  130. X
  131. Xxlisplib:
  132. X    cd $(HOME)src/xlisp; make xlisplib
  133. X
  134. Xutils:
  135. X    cd $(HOME)src/utils; make utils
  136. X    
  137. X#------------------------------------------------------------------------------
  138. X
  139. X###
  140. X### the kernel
  141. X###
  142. X
  143. Xkernel: ${LIB_DIR}libkernel_proto.a
  144. X
  145. X${LIB_DIR}libkernel_proto.a: \
  146. X        ${SHELL_SRC_DIR}shell.o \
  147. X        ${INET_SOCK_SRC_DIR}socket.o \
  148. X        ${INET_SOCK_SRC_DIR}shmem.o \
  149. X        ${INET_SOCK_SRC_DIR}talk.o \
  150. X        ${NANCY_SRC_DIR}nancy_match.o \
  151. X        ${NANCY_SRC_DIR}nancy_fundamental.o
  152. X    ${AR} $@ $?
  153. X    ${UPDATE_LIB} $@
  154. X
  155. X#------------------------------------------------------------------------------
  156. X
  157. X###
  158. X### the native primitive library
  159. X###
  160. X
  161. Xnative: ${LIB_DIR}libxvnative_glue_proto.a
  162. X
  163. X${LIB_DIR}libxvnative_glue_proto.a: \
  164. X            ${SHELL_SRC_DIR}xv_native.o \
  165. X            ${SHELL_SRC_DIR}xv_glutils.o
  166. X    ${AR} $@ $?
  167. X    ${UPDATE_LIB} $@
  168. X
  169. X#------------------------------------------------------------------------------
  170. X###
  171. X### the talk module
  172. X###
  173. X
  174. Xtalk: ${INET_SOCK_SRC_DIR}socket.o ${INET_SOCK_SRC_DIR}talk.o
  175. X
  176. X#------------------------------------------------------------------------------
  177. X
  178. X###
  179. X### the nancy module
  180. X###
  181. X
  182. Xnancy: ${NANCY_SRC_DIR}nancy.o ${NANCY_SRC_DIR}nancy_fundamental.o
  183. X
  184. X#------------------------------------------------------------------------------
  185. X
  186. X###
  187. X### the shell module
  188. X###
  189. X
  190. Xshell: ${SHELL_SRC_DIR}shell.o
  191. Xmain: ${SHELL_SRC_DIR}main.o
  192. X
  193. X#------------------------------------------------------------------------------
  194. X
  195. X###
  196. X### the fern system library
  197. X###
  198. X
  199. Xfern: ${LIB_DIR}libfern_proto.a
  200. X
  201. X${LIB_DIR}libfern_proto.a: ${FERN_SRC_DIR}fern.o
  202. X    ${AR} $@ $?
  203. X    ${UPDATE_LIB} $@
  204. X
  205. X#------------------------------------------------------------------------------
  206. X
  207. X###
  208. X### the test entity shell
  209. X###
  210. X
  211. Xtestshell: ${EXEC_DIR}testshell
  212. X    cp ${EXEC_DIR}testshell ${PUB_EXEC_DIR}testshell
  213. X
  214. X${EXEC_DIR}testshell: kernel native main fern
  215. X    ${CC} ${SHELL_SRC_DIR}main.o \
  216. X          -L${PUB_LIB_DIR} \
  217. X          -L${LIB_DIR} \
  218. X             -lxlisp \
  219. X             -lxvnative_glue_proto \
  220. X             -lkernel_proto \
  221. X             -lfern_proto \
  222. X             -lxvutils \
  223. X          ${ASSOC_LIBS} \
  224. X          -o $@
  225. X
  226. X    
  227. Xentity: testshell
  228. X    cp ${EXEC_DIR}testshell ${PUB_EXEC_DIR}entity
  229. X
  230. X#------------------------------------------------------------------------------
  231. X
  232. X###
  233. X### miscellaneous .o files
  234. X###
  235. X
  236. X.c.o:
  237. X    ${CC} -c -o $@ $<
  238. X
  239. X.c: ${KINCLUDES}
  240. X
  241. Xzoot: zoot.o
  242. X    ${CC} -o $@ $? -L$(LIB_DIR) -lkernel_proto
  243. X
  244. X#------------------------------------------------------------------------------
  245. X
  246. X###
  247. X### print the kernel
  248. X###
  249. X
  250. Xprint_kernel:
  251. X    lpr ${PUB_SRC_DIR}talk/*.c
  252. X    lpr ${PUB_SRC_DIR}nancy/*.c
  253. X    lpr ${PUB_SRC_DIR}shell/*.c
  254. X    lpr ${PUB_SRC_DIR}include/*.h
  255. X    lpr $(COMMAND_DIR)makefile
  256. X    lpr ${HOME}docs/VEOS_The_Complete_Documentation
  257. X    lpr ${HOME}docs/VEOS_Copyright
  258. X
  259. Xprint_fern:
  260. X    lpr ${PUB_SRC_DIR}fern/*.c
  261. X    lpr ${PUB_SRC_DIR}fern/*.lsp
  262. X
  263. X#------------------------------------------------------------------------------
  264. X
  265. X###
  266. X### the public kernel
  267. X###
  268. X
  269. Xpublic_kernel: ${PUB_LIB_DIR}libkernel.a ${PUB_LIB_DIR}libxvnative_glue.a
  270. X    cp ${NANCY_SRC_DIR}*.c ${PUB_SRC_DIR}nancy/.
  271. X    cp ${SHELL_SRC_DIR}*.c ${PUB_SRC_DIR}shell/.
  272. X    cp ${INET_SOCK_SRC_DIR}*.c ${PUB_SRC_DIR}talk/.
  273. X    cp ${VEOS_INCLUDE_DIR}*.h ${PUB_SRC_DIR}include/.
  274. X    cp ${VEOS_INCLUDE_DIR}world.h ${HOME}src/include/.
  275. X
  276. Xpublic_fern: ${PUB_LIB_DIR}libfern.a
  277. X    cp ${FERN_SRC_DIR}* ${PUB_SRC_DIR}fern/.
  278. X
  279. X${PUB_LIB_DIR}libkernel.a: kernel
  280. X    cp ${LIB_DIR}libkernel_proto.a $@
  281. X    ${UPDATE_LIB} $@
  282. X
  283. X${PUB_LIB_DIR}libxvnative_glue.a: native
  284. X    cp ${LIB_DIR}libxvnative_glue_proto.a $@
  285. X    ${UPDATE_LIB} $@
  286. X
  287. X${PUB_LIB_DIR}libfern.a: fern
  288. X    cp ${LIB_DIR}libfern_proto.a $@
  289. X    ${UPDATE_LIB} $@
  290. X
  291. X#------------------------------------------------------------------------------
  292. X
  293. X
  294. END_OF_FILE
  295. if test 7306 -ne `wc -c <'kernel_private/makefile'`; then
  296.     echo shar: \"'kernel_private/makefile'\" unpacked with wrong size!
  297. fi
  298. # end of 'kernel_private/makefile'
  299. fi
  300. if test -f 'kernel_private/src/fern/fgod.lsp' -a "${1}" != "-c" ; then 
  301.   echo shar: Will not clobber existing file \"'kernel_private/src/fern/fgod.lsp'\"
  302. else
  303. echo shar: Extracting \"'kernel_private/src/fern/fgod.lsp'\" \(9175 characters\)
  304. sed "s/^X//" >'kernel_private/src/fern/fgod.lsp' <<'END_OF_FILE'
  305. X;;-----------------------------------------------------------
  306. X;; file: fgod.lsp
  307. X;;
  308. X;; FERN is the Fractal Entity Relativity Node.
  309. X;; This file is the FGOD compenent of the Fern System.
  310. X;;
  311. X;; creation: February 28, 1992
  312. X;;
  313. X;; by Geoffrey P. Coco at the HITLab, Seattle
  314. X;;-----------------------------------------------------------
  315. X
  316. X;;-----------------------------------------------------------
  317. X;; Copyright (C) 1992  Geoffrey P. Coco,
  318. X;; Human Interface Technology Lab, Seattle
  319. X;;-----------------------------------------------------------
  320. X
  321. X
  322. X;;-----------------------------------------------------------
  323. X#|
  324. X
  325. XThese functions provide users of the Fern System with clean
  326. Xand well-defined mechanisms for directly affecting other
  327. Xentities.  They represent the god component of the the Fern
  328. Xsystem (or FGOD).  The FGOD primarily administrates a common
  329. Xprotocol for passing proactive instructions between entities.
  330. X
  331. X|#
  332. X;;-----------------------------------------------------------
  333. X;;            FGOD PUBLIC FUNCTIONS
  334. X;;-----------------------------------------------------------
  335. X
  336. X
  337. X;; fgod-make-node
  338. X
  339. X;; dynamically create an entity ... somewhere.
  340. X;; pass which host where entity will run,
  341. X;; the binary executable of the entity,
  342. X;; and the lisp program for the entity to execute.
  343. X;; all these args are strings; defaults are below.
  344. X
  345. X(defun fgod-make-node (&key (run-host (aref self 0))
  346. X                (binary "entity")
  347. X                (program "/home/veos/lisp/tabula_rasa")
  348. X                (display-host (aref self 0)))
  349. X  (progn
  350. X
  351. X    ;; make sure that entity can display locally
  352. X    (cond ((equal display-host (aref self 0))
  353. X       (cond ((not (equal run-host (aref self 0)))
  354. X          (system (sprintf "xhost + " run-host))))))
  355. X
  356. X    ;; make unix call to launch remote entity
  357. X    (system (fgod-rsh-command run-host binary program display-host))
  358. X
  359. X    ;; now, wait for reply of success
  360. X    ;; this is handled remotely by fgod-be-node
  361. X    (printf1 "waiting for offspring to respond...")
  362. X
  363. X    ;; this var gets set by new entity via remote proc call to us - 
  364. X    ;; as part of it's startup protocol (see fgod-be-node)
  365. X    (setq fern-descendent nil)
  366. X
  367. X    (read-time)
  368. X    (do ((reply nil) (timer 0))
  369. X    ((cond 
  370. X
  371. X      ;; the entity lives !!!
  372. X      (fern-descendent
  373. X       (printf1 "\noffspring was: " (uid2str fern-descendent))
  374. X       (setq reply fern-descendent)
  375. X       (setq fern-descendent nil)
  376. X       t)
  377. X
  378. X      ;; new entity didn't respond in reasonable amount of time
  379. X      ((> timer fgod-timeout)
  380. X       (printf "\noffspring didn't respond.")
  381. X       t))
  382. X
  383. X     reply)
  384. X
  385. X    ;; give time to persist procs and hope for reply message.
  386. X    ;; reply is in the form: (setq fern-descendent new-entity-uid)
  387. X    (fcon-time)
  388. X
  389. X    (setq timer (+ timer (read-time)))
  390. X    )
  391. X    ))
  392. X
  393. X;;-----------------------------------------------------------
  394. X
  395. X;; fgod-impart
  396. X
  397. X#|
  398. Xarguments:
  399. X     uid of desired entity and
  400. X     *quoted* function call.
  401. X
  402. Xexecute remote lisp functions.
  403. X
  404. Xconsider this example of the proper way to use fgod-impart:
  405. X
  406. X    (fgod-implant #("iris2" 5503) `(fe-enter ,self))
  407. X
  408. Xthis call will cause the remote entity to 'enter' your entity as a
  409. Xspace.  this can be used for smart portals.
  410. X
  411. Xwe quote the remote function call so that the function is finally
  412. Xevaluated by the catcher of this message - not by the thrower.
  413. X
  414. Xnotice that the code we want to send contains a variable (i.e. self)
  415. Xwhich we want to evaluate *before* the message is thrown.  we can use
  416. Xthe 'backquote-comma' syntax as shown to do this.
  417. X
  418. Xhere is another, more complex example:
  419. X
  420. X   (fgod-impart #("iris2" 5503)
  421. X         `(setq remote-var
  422. X                        (list ,(+ local-x local-y) (+ remote-x remote-y))))
  423. X
  424. Xagain, we quote the entire message with backquote.  but we want to
  425. Xevaluate the expression (+ local-x local-y) *before* throwing, thus
  426. Xthe comma before this expression.
  427. X
  428. Xnotice that the second argument to setq is a call to (list ...).  this
  429. Xis also passed on unevaluated to the catching entity.  when this
  430. Xmessage is eventually evaluated, it will then create a list of the
  431. Xalready computed (+ local-x local-y) value and the result of the
  432. Xexpression (+ remote-x remote-y).
  433. X
  434. Xto restate, the (+ remote-x remote-y) is evaluated by the catcher of
  435. Xthe message.  the (list ...) is so that the remote lisp will not try
  436. Xto evaluate (<computed-val> (+ local-x local-y)) as a function call.
  437. X
  438. XNOTE: please use this function for remote entity editing, rather than
  439. Xcalling vthrow yourself - in the future, this function will also throw
  440. Xan ancestral password.  
  441. X|#
  442. X
  443. X
  444. X(defun fgod-impart (uid remote-func-call)
  445. X  (vthrow (list uid) remote-func-call))
  446. X
  447. X;;-----------------------------------------------------------
  448. X
  449. X;; same as fgod-impart except that it holds and waits the
  450. X;; the result of the remote function call.
  451. X;; timeout is in seconds
  452. X
  453. X(defun fgod-seq-impart (uid remote-func-call)
  454. X  (progn
  455. X    (vthrow (list uid) `(fgod-seq-remote ,self ,remote-func-call))
  456. X    
  457. X    (setq fgod-seq-reply nil)
  458. X    (read-time)
  459. X    (do ((reply nil) (timer 0))
  460. X
  461. X    ((cond
  462. X      
  463. X      ;; the entity responded !!!
  464. X      (fgod-seq-reply
  465. X       ;; the remote entity will pass back the result inside an extra list.
  466. X       ;; this is so we can distinguish between no reponse and a response of nil.
  467. X       (setq reply (car fgod-seq-reply))
  468. X       (setq fgod-seq-reply nil)
  469. X       t)
  470. X      
  471. X      ;; entity didn't respond in adequate time
  472. X      ((> timer fgod-timeout)
  473. X       t))
  474. X
  475. X     reply)
  476. X
  477. X    ;; give time to persist procs and hope for reply message.
  478. X    ;; reply is in the form: (setq fgod-seq-reply data)
  479. X    (fcon-time)
  480. X
  481. X    (setq timer (+ timer (read-time)))
  482. X    )
  483. X    ))
  484. X
  485. X
  486. X;;-----------------------------------------------------------
  487. X
  488. X
  489. X;;-----------------------------------------------------------
  490. X;;            FGOD PRIVATE FUNCTIONS
  491. X;;-----------------------------------------------------------
  492. X
  493. X(defun fgod-init ()
  494. X  ;; try to alert creator that we made it
  495. X  (fgod-be-node)
  496. X
  497. X  (setq fgod-timeout 15)
  498. X  )
  499. X
  500. X;;-----------------------------------------------------------
  501. X
  502. X;; generate command string to pass to unix which does:
  503. X;; rsh to host,
  504. X;; xterm with display to local screen,
  505. X;; and run a chosen entity with a chosen startup program.
  506. X
  507. X(defun fgod-rsh-command (run-host binary program display-host)
  508. X  (progn
  509. X
  510. X    (cond (fern-debug
  511. X       (printf "run-host: " run-host)
  512. X       (printf "binary: " binary)
  513. X       (printf "program: " program)
  514. X       (printf "display-host: " display-host)))
  515. X    
  516. X    (let (xterm-command
  517. X      window-title
  518. X      entity-command)
  519. X      (setq
  520. X       entity-command (sprintf
  521. X               ;; xlisp binary to execute
  522. X               binary
  523. X               " "
  524. X               ;; the ancestor bits
  525. X               (fgod-ancestor-code)
  526. X               " "
  527. X               ;; the xlisp startup program
  528. X               program
  529. X               )
  530. X       window-title (sprintf binary "@" run-host)
  531. X       xterm-command (sprintf
  532. X              ;; call xterm remotely
  533. X              "xterm "
  534. X              ;; xterm window coords
  535. X              "-geometry "
  536. X              (fgod-new-wind)
  537. X              " "
  538. X              ;; xwindow tricks
  539. X              "-iconic "
  540. X              ;; xterm window name
  541. X              "-T "
  542. X              window-title
  543. X              " "
  544. X              ;; display on chosen screen
  545. X              (cond ((not (equal run-host display-host))
  546. X                 (sprintf
  547. X                  "-display "
  548. X                  (fgod-host-xwindow display-host)
  549. X                  " ")))
  550. X              ;; the entity program
  551. X              "-e "
  552. X              entity-command))
  553. X      
  554. X      (cond 
  555. X       ;; local case is simple, no rsh needed
  556. X       ((equal run-host (aref self 0))
  557. X    (sprintf
  558. X     ;; the remote command
  559. X     xterm-command
  560. X     " "
  561. X     ;; make this a local background process
  562. X     "&"))
  563. X       
  564. X       ;; remote case, rsh the entire command
  565. X       (t
  566. X    (sprintf "rsh "
  567. X         ;; where to rsh
  568. X         run-host 
  569. X         ;; don't pass this terminal's input to it.
  570. X         " -n "
  571. X         ;; the remote command
  572. X         "\"" xterm-command "\" "
  573. X         ;; make this a local background process
  574. X         "&")))
  575. X      )))
  576. X
  577. X;;-----------------------------------------------------------
  578. X
  579. X;; generate command string for X-window placement on screen.
  580. X;; with repeated calls, this produces geometry for tiled windows.
  581. X
  582. X(defun fgod-new-wind ()
  583. X  (progn
  584. X    (cond ((boundp 'xwindow-place)
  585. X       (setf (nth 1 xwindow-place) (- (nth 1 xwindow-place) 25))
  586. X       (setf (nth 3 xwindow-place) (- (nth 3 xwindow-place) 25)))
  587. X      (t
  588. X       (setq xwindow-place '("76x15+" 430 "+" 640))))
  589. X    (eval `(sprintf ,@xwindow-place))))
  590. X
  591. X
  592. X;;-----------------------------------------------------------
  593. X
  594. X(defmacro fgod-ancestor-code ()
  595. X  (sprintf "/home/veos/lisp/ancestors/" 
  596. X       (aref self 0) "_" (aref self 1) ".lsp "))
  597. X
  598. X(defun fgod-host-xwindow (display-host)
  599. X  (sprintf display-host ":0.0"))
  600. X
  601. X;;-----------------------------------------------------------
  602. X
  603. X;; the remote reply handler for fgod-seq-impart
  604. X(defun fgod-seq-remote (sender-uid local-func-call)
  605. X  ;; note the particular protocol, here.
  606. X  ;; we send the reply inside an extra list.
  607. X  ;; this is so that the remote caller (fgod-seq-impart) can
  608. X  ;; distinguish between no response and a response of nil
  609. X  (vthrow (list sender-uid) `(setq fgod-seq-reply '(,local-func-call))))
  610. X
  611. X;;-----------------------------------------------------------
  612. X
  613. X;; remote counterpart to fgod-make-node
  614. X(defun fgod-be-node ()
  615. X  (cond ((boundp 'fern-ancestor)
  616. X     (printf "throwing to ancestor...")
  617. X     (print (vthrow `(,fern-ancestor) `(setq fern-descendent ,self)))
  618. X     t)))
  619. X
  620. X;;-----------------------------------------------------------
  621. X
  622. X
  623. END_OF_FILE
  624. if test 9175 -ne `wc -c <'kernel_private/src/fern/fgod.lsp'`; then
  625.     echo shar: \"'kernel_private/src/fern/fgod.lsp'\" unpacked with wrong size!
  626. fi
  627. # end of 'kernel_private/src/fern/fgod.lsp'
  628. fi
  629. if test -f 'kernel_private/src/include/world.h' -a "${1}" != "-c" ; then 
  630.   echo shar: Will not clobber existing file \"'kernel_private/src/include/world.h'\"
  631. else
  632. echo shar: Extracting \"'kernel_private/src/include/world.h'\" \(7962 characters\)
  633. sed "s/^X//" >'kernel_private/src/include/world.h' <<'END_OF_FILE'
  634. X/****************************************************************************************
  635. X * file: world.h                                    *
  636. X *                                            *
  637. X * May 18, 1991:  any veos code - kernel or prims - should use this include.        *
  638. X *                                                    *
  639. X * by Geoffrey P. Coco at the HITLab, Seattle.                          *
  640. X *                                            *
  641. X ****************************************************************************************/
  642. X
  643. X/****************************************************************************************
  644. X * Copyright (C) 1992  Geoffrey P. Coco, Human Interface Technology Lab, Seattle    *
  645. X ****************************************************************************************/
  646. X
  647. X
  648. X/****************************************************************************************
  649. X ** common includes **
  650. X ****************************************************************************************/
  651. X
  652. X#include <stdio.h>
  653. X#include <errno.h>
  654. X#include <string.h>
  655. X#include <sys/types.h>
  656. X#include <sys/time.h>
  657. X
  658. X/****************************************************************************************
  659. X ** common useful structures **
  660. X ****************************************************************************************/
  661. X
  662. X
  663. Xtypedef int        TVeosErr;   /* return type of all veos functions */
  664. X
  665. Xtypedef char        boolean;            
  666. X
  667. Xtypedef char        str63[63];
  668. Xtypedef char        str15[15];
  669. Xtypedef char        str255[255];
  670. X
  671. X
  672. Xtypedef u_long        TTimeStamp, *TPTimeStamp, **THTimeStamp;
  673. X
  674. Xtypedef struct {
  675. X    union {
  676. X    float  f;
  677. X    long   l;
  678. X    } u;
  679. X    } TF2L;
  680. X
  681. X/****************************************************************************************
  682. X ** the grouple structure **
  683. X ****************************************************************************************/
  684. X
  685. X/** grouple element types **/
  686. X
  687. X#define GR_unspecified    0
  688. X
  689. X#define GR_grouple    1
  690. X#define GR_vector    2
  691. X#define GR_float    3
  692. X#define GR_int        4
  693. X#define GR_prim        5
  694. X#define GR_string    6
  695. X
  696. X#define GR_these    10
  697. X#define GR_theseall    11
  698. X#define GR_some        12
  699. X#define GR_any               13
  700. X#define GR_here        14
  701. X
  702. X#define GR_mark        15
  703. X#define GR_touch    16
  704. X
  705. X
  706. Xtypedef struct grouple     *TPGrouple;
  707. Xtypedef struct grouple     **THGrouple;
  708. X
  709. X
  710. Xtypedef struct {
  711. X    int            iType;
  712. X    union {
  713. X    char        *pU;
  714. X
  715. X    char        *pS;
  716. X    TPGrouple    pGr;
  717. X
  718. X    float        fVal;
  719. X    int        iVal;
  720. X
  721. X    } u;
  722. X
  723. X    TTimeStamp        tLastMod;
  724. X    int            iFlags;
  725. X
  726. X    } TElt,
  727. X      *TPElt,
  728. X      **THElt;
  729. X
  730. X
  731. Xtypedef struct grouple {
  732. X        int             iElts;
  733. X        TElt            *pEltList;
  734. X
  735. X    int        iFlags;
  736. X
  737. X        } TGrouple;
  738. X
  739. X/****************************************************************************************
  740. X ** common VEOS constants **
  741. X ****************************************************************************************/
  742. X
  743. X#ifndef TRUE
  744. X#define TRUE    1
  745. X#endif
  746. X
  747. X#ifndef FALSE
  748. X#define FALSE    0
  749. X#endif
  750. X
  751. X#ifndef nil
  752. X#define nil    0
  753. X#endif
  754. X
  755. X/****************************************************************************************
  756. X ** VEOS-wide return values **
  757. X ****************************************************************************************/
  758. X
  759. X#define VEOS_FAILURE        -1       /* values of type TVeosErr */
  760. X#define VEOS_NEUTRAL        0
  761. X#define VEOS_SUCCESS        1
  762. X
  763. X#define VEOS_EOF        -2
  764. X#define VEOS_MEM_ERR        -3
  765. X#define VEOS_FILE_ERR        -4
  766. X#define VEOS_DATA_ERR        -5
  767. X
  768. X/****************************************************************************************
  769. X ** common Nancy constants **
  770. X ****************************************************************************************/
  771. X
  772. X#define NANCY_LessThan            -217
  773. X#define NANCY_GreaterThan        -218
  774. X#define NANCY_EndOfGrouple        -220
  775. X
  776. X#define NANCY_MisplacedLeftBracket    -223
  777. X#define NANCY_MisplacedRightBracket    -222
  778. X#define NANCY_MissingRightBracket       -224
  779. X
  780. X#define NANCY_NoTypeMatch        -225
  781. X#define NANCY_BadType            -226
  782. X
  783. X#define NANCY_MatchIncomplete        -229
  784. X#define NANCY_MatchOne            -230
  785. X#define NANCY_MatchMany            -231
  786. X
  787. X#define NANCY_CopyMatch            -232
  788. X#define NANCY_RemoveMatch        -233
  789. X#define NANCY_GimmeMatch        -234
  790. X#define NANCY_ReplaceMatch        -235
  791. X
  792. X#define NANCY_NoMatch            -236
  793. X#define NANCY_NotSupported        -237
  794. X
  795. X#define NANCY_SrcTooShort        -238
  796. X#define NANCY_PatTooShort        -239
  797. X
  798. X#define NANCY_Explicit             -245
  799. X#define NANCY_Implicit             -246
  800. X
  801. X/****************************************************************************************
  802. X ** common Shell constants **
  803. X ****************************************************************************************/
  804. X
  805. X
  806. X
  807. X/****************************************************************************************
  808. X ** common Talk constants **
  809. X ****************************************************************************************/
  810. X
  811. X#define TALK_BOGUS_FD    -1        /* real file descriptors are non-neg */
  812. X#define TALK_BOGUS_HOST    -1
  813. X#define TALK_BOGUS_PORT    -1
  814. X
  815. X/****************************************************************************************
  816. X ** common useful macros **
  817. X ****************************************************************************************/
  818. X
  819. X
  820. X
  821. X/** SunOS requires 4th-word alignment when allocating memory on Sun 4's 
  822. X ** but other machines must use same scheme for network compatibility. 
  823. X ** ... lowest common denominator ... 
  824. X **/
  825. X#define MEMSIZE(sz)  (((sz) + 3) & 0xFFFFFFFC)
  826. X
  827. X#define MALLOC(sz)  malloc(MEMSIZE(sz))
  828. X#define REMALLOC(ptr, sz) realloc(ptr, MEMSIZE(sz))
  829. X
  830. X#define NEWPTR(ptr, type, size)  (ptr = (type) MALLOC(size))
  831. X#define AGAINPTR(destptr, srcptr, type, size)  (destptr = (type) REMALLOC(srcptr, size))
  832. X
  833. X#define DELETE(var)      free((char *) var)
  834. X#define DUMP(ptr)    free((char *) ptr)
  835. X
  836. X
  837. X#define SETFLAG(flag, flagvar)        flagvar |= flag
  838. X#define CLRFLAG(flag, flagvar)        flagvar &= ~flag
  839. X#define TESTFLAG(flag, flagvar)        ((flag & flagvar) ? TRUE : FALSE)
  840. X
  841. X#define SAVE_FLAGS(flag, save)      { save = flag & NANCY_FlagMask;   \
  842. X                     flag &= ~NANCY_FlagMask; }
  843. X
  844. X#define RESTORE_FLAGS(flag, save)   { flag |= save; }
  845. X                    
  846. X
  847. X#define TIME_LESS_THAN(time1, time2)     (time1 < time2)
  848. X
  849. X#define CATCH_TRAP(iSignal, bTrapped) \
  850. X    if (TRAP_FLAGS & 0x00000001 << iSignal) { \
  851. X    TRAP_FLAGS = TRAP_FLAGS & ~(0x00000001 << iSignal); \
  852. X    TERMINATE = FALSE; \
  853. X    bTrapped = TRUE; \
  854. X    } \
  855. X    else \
  856. X    bTrapped = FALSE;
  857. X
  858. X#define NANCY_EltMarkMask    0x40000000
  859. X#define NANCY_EltMatchMask    0x20000000
  860. X#define NANCY_EltTouchMask    0x10000000
  861. X#define NANCY_FlagMask        0x70000000
  862. X
  863. X#define NANCY_MarkWithinMask     0x00000001
  864. X#define NANCY_TouchWithinMask     0x00000008
  865. X#define NANCY_ContentMask     0x00000002
  866. X#define NANCY_VectorMask     0x00000004
  867. X
  868. X#define NEW_GROUPLE(pGrouple) \
  869. X{ \
  870. X    Nancy_NewGrouple(&pGrouple); \
  871. X    }
  872. X
  873. X#define NEW_ELT(iType, pData, pElt) \
  874. X{ \
  875. X    Nancy_CreateElement(pElt, iType, 0); \
  876. X    bcopy((char *) pData, pElt->u.pU, TYPE_SIZES[iType]); \
  877. X    }
  878. X
  879. X#define INSERT_ELT(pGrouple, pElt, iLoc) \
  880. X{ \
  881. X    Nancy_NewElementsInGrouple(pGrouple, iLoc, 1, GR_unspecified, 0); \
  882. X    pGrouple->pEltList[iLoc] = *pElt; \
  883. X    }  
  884. X
  885. X#define charsymbolp(s, ch)      (symbolp(s) &&            \
  886. X                getstring(getpname(s))[0] == ch &&    \
  887. X                getstring(getpname(s))[1] == '\0')
  888. X
  889. X#define TIME2XELT(time, pElt) \
  890. X{ \
  891. X    TF2L       fTrans; \
  892. X    fTrans.u.l = time; \
  893. X    setflonum(pElt, fTrans.u.f); \
  894. X    }
  895. X
  896. X
  897. X#define XELT2TIME(pElt, time) \
  898. X{ \
  899. X    TF2L       fTrans; \
  900. X    fTrans.u.f = getflonum(pElt); \
  901. X    time = fTrans.u.l; \
  902. X    }
  903. X
  904. X
  905. X/****************************************************************************************
  906. X ** public globals setup by the kernel **
  907. X ****************************************************************************************/
  908. X
  909. X#ifdef MAIN_MODULE
  910. Xstr63            Veos_sUid;
  911. Xboolean            Veos_bTerminate;
  912. X#else
  913. Xextern str63        Veos_sUid;
  914. Xextern boolean        Veos_bTerminate;
  915. X#endif
  916. X
  917. X#define WHOAMI        Veos_sUid
  918. X#define TERMINATE    Veos_bTerminate
  919. X
  920. X/****************************************************************************************
  921. X ** C utils for prim programmers **
  922. X ****************************************************************************************/
  923. X
  924. X#ifdef _DEC_
  925. Xextern char *strdup();
  926. X#endif
  927. X
  928. X/****************************************************************************************
  929. X
  930. X ****************************************************************************************/
  931. X
  932. X
  933. END_OF_FILE
  934. if test 7962 -ne `wc -c <'kernel_private/src/include/world.h'`; then
  935.     echo shar: \"'kernel_private/src/include/world.h'\" unpacked with wrong size!
  936. fi
  937. # end of 'kernel_private/src/include/world.h'
  938. fi
  939. if test -f 'kernel_private/src/talk/shmem.c' -a "${1}" != "-c" ; then 
  940.   echo shar: Will not clobber existing file \"'kernel_private/src/talk/shmem.c'\"
  941. else
  942. echo shar: Extracting \"'kernel_private/src/talk/shmem.c'\" \(8706 characters\)
  943. sed "s/^X//" >'kernel_private/src/talk/shmem.c' <<'END_OF_FILE'
  944. X/****************************************************************************************
  945. X *                                            *
  946. X * file: ShMem.c                                                *
  947. X *                                            *
  948. X * April 6, 1992: The shared memory handler for the Talk module of VEOS            *
  949. X *                                            *
  950. X * by Geoffrey P. Coco at the HITLab, Seattle.                          *
  951. X *                                            *
  952. X ****************************************************************************************/
  953. X
  954. X/****************************************************************************************
  955. X * Copyright (C) 1992  Geoffrey P. Coco, Human Interface Technology Lab, Seattle    *
  956. X ****************************************************************************************/
  957. X
  958. X
  959. X/****************************************************************************************
  960. X *                      include the papa include file                */
  961. X
  962. X#include "kernel.h"
  963. X#include <signal.h>
  964. X
  965. X/****************************************************************************************/
  966. X
  967. X
  968. X
  969. X/****************************************************************************************/
  970. XTVeosErr ShMem_Init()
  971. X{
  972. X    TVeosErr        iErr;
  973. X    boolean        bTrap;
  974. X    str255        sSave;
  975. X
  976. X    iErr = VEOS_SUCCESS;
  977. X
  978. X#ifdef _SG_
  979. X    usconfig(CONF_INITSIZE, SHMEM_SHARED_BUF_SIZE);
  980. X    
  981. X    iErr = SHMEM_INIT_ERR;
  982. X
  983. X    SHMEM_ARENA = usinit(SHMEM_ARENA_FILE);
  984. X
  985. X    CATCH_TRAP(SIGBUS, bTrap);
  986. X    if (bTrap || (SHMEM_ARENA == nil)) {
  987. X    strcpy(sSave, "/bin/rm/ -f ");
  988. X    strcat(sSave, SHMEM_ARENA_FILE);
  989. X    system(sSave);
  990. X    SHMEM_ARENA = usinit(SHMEM_ARENA_FILE);
  991. X    }
  992. X
  993. X    if (TALK_BUGS)
  994. X    fprintf(stderr, "talk %s: attaching to shared memory arena %s\n",
  995. X        WHOAMI, SHMEM_ARENA ? "was successful" : "failed");
  996. X    
  997. X    if (SHMEM_ARENA) {
  998. X    
  999. X    SHMEM_DOMAIN = usgetinfo(SHMEM_ARENA);
  1000. X    
  1001. X    if (TALK_BUGS)
  1002. X        fprintf(stderr, "talk %s: veos communication domain %s\n", 
  1003. X            WHOAMI, SHMEM_DOMAIN ? "found" : "not found, creating one...");
  1004. X
  1005. X    if (SHMEM_DOMAIN == nil) {
  1006. X        /** first entity on this machine,
  1007. X         ** initialize the shmem domain
  1008. X         **/
  1009. X        
  1010. X        chmod(SHMEM_ARENA_FILE, 0777);
  1011. X        
  1012. X        iErr = VEOS_MEM_ERR;
  1013. X        SHMEM_DOMAIN = usmalloc(sizeof(TShDomainRec), SHMEM_ARENA);
  1014. X        
  1015. X        if (SHMEM_DOMAIN) {
  1016. X        
  1017. X        SHMEM_DOMAIN->pChainSem = usnewsema(SHMEM_ARENA, 1);
  1018. X        SHMEM_DOMAIN->pChannelChain = nil;
  1019. X        
  1020. X        usputinfo(SHMEM_ARENA, SHMEM_DOMAIN);
  1021. X        }
  1022. X        }
  1023. X
  1024. X    
  1025. X    if (SHMEM_DOMAIN) {
  1026. X        
  1027. X        if (TALK_BUGS)
  1028. X        fprintf(stderr, "talk %s: creating memory listen channel...\n", WHOAMI);
  1029. X        
  1030. X        iErr = VEOS_MEM_ERR;
  1031. X        SHMEM_CHANNEL = usmalloc(sizeof(TSharedRec), SHMEM_ARENA);
  1032. X
  1033. X        if (SHMEM_CHANNEL) {
  1034. X        
  1035. X        SHMEM_CHANNEL->iPort = IDENT_ADDR.iPort;
  1036. X        SHMEM_CHANNEL->pSem = usnewsema(SHMEM_ARENA, 1);
  1037. X        SHMEM_CHANNEL->pAvail = &SHMEM_CHANNEL->pBuffer[0];
  1038. X        SHMEM_CHANNEL->pEnd = &SHMEM_CHANNEL->pBuffer[0] + SHMEM_RW_BUF_SIZE;
  1039. X        
  1040. X        
  1041. X        /** link new entity channel into shared domain record **/
  1042. X        
  1043. X        uspsema(SHMEM_DOMAIN->pChainSem);
  1044. X        
  1045. X        SHMEM_CHANNEL->pNext = SHMEM_DOMAIN->pChannelChain;
  1046. X        SHMEM_DOMAIN->pChannelChain = SHMEM_CHANNEL;
  1047. X        
  1048. X        usvsema(SHMEM_DOMAIN->pChainSem);
  1049. X        
  1050. X        iErr = VEOS_SUCCESS;
  1051. X        }
  1052. X        }
  1053. X    }
  1054. X#endif
  1055. X
  1056. X    return(iErr);
  1057. X
  1058. X    } /* ShMem_Init */
  1059. X/****************************************************************************************/
  1060. X
  1061. X
  1062. X
  1063. X/****************************************************************************************/
  1064. XTVeosErr ShMem_Close()
  1065. X{
  1066. X    TVeosErr           iErr;
  1067. X    boolean        bLast = FALSE;
  1068. X    THSharedRec        hFinger;
  1069. X    TPSharedRec        pSaveLink;
  1070. X    TPSemaphor        pSaveSem;
  1071. X
  1072. X    iErr = VEOS_SUCCESS;
  1073. X
  1074. X#ifdef _SG_
  1075. X    /** stop others from looking at the channel chain **/
  1076. X    uspsema(SHMEM_DOMAIN->pChainSem);
  1077. X
  1078. X    /** this channel is about to vanish
  1079. X     ** wait for others to finish looking at this channel
  1080. X     **/
  1081. X    pSaveSem = SHMEM_CHANNEL->pSem;
  1082. X    uspsema(pSaveSem);
  1083. X
  1084. X    /** find our channel in the domain channel chain, 
  1085. X     ** remove it, recoupling the links, and free the memory
  1086. X     **/
  1087. X    hFinger = &SHMEM_DOMAIN->pChannelChain;
  1088. X    while (*hFinger) {
  1089. X
  1090. X    if (*hFinger == SHMEM_CHANNEL) {
  1091. X        pSaveLink = (*hFinger)->pNext;
  1092. X        usfree(*hFinger, SHMEM_ARENA);
  1093. X        *hFinger = pSaveLink;
  1094. X        break;
  1095. X        }
  1096. X    hFinger = &(*hFinger)->pNext;
  1097. X    }
  1098. X
  1099. X    /** release and remove the channel semaphore **/
  1100. X    usvsema(pSaveSem);
  1101. X    usfreesema(pSaveSem, SHMEM_ARENA);
  1102. X
  1103. X    if (SHMEM_DOMAIN->pChannelChain == nil)
  1104. X    bLast = TRUE;
  1105. X
  1106. X    /** allow others to cleanly find no channel **/
  1107. X    usvsema(SHMEM_DOMAIN->pChainSem);
  1108. X    
  1109. X    if (bLast) {
  1110. X    usfreesema(SHMEM_DOMAIN->pChainSem, SHMEM_ARENA);
  1111. X    usfree(SHMEM_DOMAIN, SHMEM_ARENA);
  1112. X    unlink(SHMEM_ARENA_FILE);
  1113. X    }
  1114. X#endif
  1115. X
  1116. X    return(iErr);
  1117. X
  1118. X    } /* ShMem_Close */
  1119. X/****************************************************************************************/
  1120. X
  1121. X
  1122. X
  1123. X/****************************************************************************************/
  1124. XTVeosErr ShMem_WriteMessages(pSpeakNode)
  1125. X    TPSpeakNode        pSpeakNode;
  1126. X{
  1127. X    TVeosErr        iErr = VEOS_FAILURE;
  1128. X    int            iLen;
  1129. X    TPMessageNode    pSaveLink;
  1130. X    char        *sMessage;
  1131. X    TPSharedRec        pWriteChannel;
  1132. X
  1133. X
  1134. X#ifdef _SG_
  1135. X    iErr = ShMem_FindChannel(pSpeakNode->destRec.iPort, &pWriteChannel);
  1136. X
  1137. X    if (iErr != VEOS_SUCCESS)
  1138. X    iErr = TALK_CONN_CLOSED;
  1139. X
  1140. X    else {
  1141. X
  1142. X    /** dispatch message sending...             
  1143. X     ** oldest jobs first to enforce sequencing
  1144. X     **/        
  1145. X    
  1146. X    do {
  1147. X        /** attempt to transmit oldest message **/
  1148. X        
  1149. X        sMessage = pSpeakNode->pMessageQ->sMessage;
  1150. X        iLen = pSpeakNode->pMessageQ->iMsgLen;
  1151. X        
  1152. X
  1153. X
  1154. X        /** wait for exclusive rights to memory channel **/
  1155. X
  1156. X        uspsema(pWriteChannel->pSem);
  1157. X
  1158. X
  1159. X
  1160. X        /** check for available space in buffer **/
  1161. X#ifndef OPTIMAL        
  1162. X        if (TALK_BUGS) {
  1163. X        fprintf(stderr, "speak %s: buffer has %d bytes avail.\n",
  1164. X            WHOAMI, pWriteChannel->pEnd - pWriteChannel->pAvail);
  1165. X        }
  1166. X#endif
  1167. X        if (pWriteChannel->pAvail + iLen > pWriteChannel->pEnd)
  1168. X        iErr = SHMEM_FULL;
  1169. X
  1170. X        else {
  1171. X        /** write the message **/
  1172. X            
  1173. X        bcopy(sMessage, pWriteChannel->pAvail, iLen);
  1174. X        pWriteChannel->pAvail += iLen;
  1175. X#ifndef OPTIMAL
  1176. X        if (TALK_BUGS)
  1177. X            fprintf(stderr, "speak %s: wrote message, length: %d\n",
  1178. X                WHOAMI, iLen);
  1179. X#endif
  1180. X        }
  1181. X
  1182. X        /** give up rights to memory channel **/
  1183. X
  1184. X        usvsema(pWriteChannel->pSem);
  1185. X
  1186. X
  1187. X        if (iErr == VEOS_SUCCESS) {
  1188. X
  1189. X        /** dequeue this message from connection record **/
  1190. X        
  1191. X        DUMP(sMessage);
  1192. X        
  1193. X        
  1194. X        pSaveLink = pSpeakNode->pMessageQ->pLink;
  1195. X        Shell_ReturnBlock(pSpeakNode->pMessageQ,
  1196. X                  sizeof(TMessageNode), "message node");
  1197. X        pSpeakNode->pMessageQ = pSaveLink;
  1198. X        }
  1199. X
  1200. X        } while (pSpeakNode->pMessageQ && iErr == VEOS_SUCCESS);
  1201. X    }
  1202. X
  1203. X#endif
  1204. X
  1205. X    return(iErr);
  1206. X
  1207. X    } /* ShMem_WriteMessages */
  1208. X/****************************************************************************************/
  1209. X
  1210. X
  1211. X
  1212. X
  1213. X/****************************************************************************************/
  1214. XTVeosErr ShMem_GatherMessages()
  1215. X{
  1216. X    TVeosErr        iErr = VEOS_SUCCESS;
  1217. X    char        *pFinger;
  1218. X    TMsgRec        pbMsg;
  1219. X
  1220. X#ifdef _SG_
  1221. X    uspsema(SHMEM_CHANNEL->pSem);
  1222. X    
  1223. X    /** check for any data in buffer **/
  1224. X    if (SHMEM_CHANNEL->pAvail > SHMEM_CHANNEL->pBuffer) {
  1225. X    
  1226. X    pFinger = SHMEM_CHANNEL->pBuffer;
  1227. X    while (pFinger < SHMEM_CHANNEL->pAvail) {
  1228. X
  1229. X        pbMsg.iLen = ((int *) pFinger)[0];
  1230. X        pFinger += 4;
  1231. X        pbMsg.sMessage = pFinger;
  1232. X        
  1233. X        (*TALK_MSG_FUNC) (&pbMsg);
  1234. X
  1235. X        pFinger += pbMsg.iLen;
  1236. X        }
  1237. X    
  1238. X    /** mark buffer empty again **/
  1239. X    SHMEM_CHANNEL->pAvail = SHMEM_CHANNEL->pBuffer;
  1240. X    }
  1241. X
  1242. X    usvsema(SHMEM_CHANNEL->pSem);
  1243. X#endif
  1244. X
  1245. X    return(iErr);
  1246. X
  1247. X    } /* ShMem_GatherMessages */
  1248. X/****************************************************************************************/
  1249. X
  1250. X
  1251. X
  1252. X
  1253. X/****************************************************************************************/
  1254. Xboolean ShMem_CanShareMem(pUid)
  1255. X    TPUid    pUid;
  1256. X{
  1257. X    boolean    bSharedMem = FALSE;
  1258. X
  1259. X#ifdef _SG_
  1260. X    if (pUid->lHost == IDENT_ADDR.lHost &&
  1261. X    pUid->iPort != IDENT_ADDR.iPort)
  1262. X    bSharedMem = TRUE;
  1263. X#endif
  1264. X
  1265. X    return(bSharedMem);
  1266. X
  1267. X    } /* ShMem_CanShareMem */
  1268. X/****************************************************************************************/
  1269. X
  1270. X
  1271. X
  1272. X/****************************************************************************************/
  1273. XTVeosErr ShMem_FindChannel(iPort, hChannel)
  1274. X    int            iPort;
  1275. X    THSharedRec        hChannel;
  1276. X{
  1277. X    TVeosErr        iErr = VEOS_FAILURE;
  1278. X    TPSharedRec        pFinger;
  1279. X
  1280. X    *hChannel = nil;
  1281. X
  1282. X#ifdef _SG_
  1283. X    /** find channel for this destination **/
  1284. X    
  1285. X    uspsema(SHMEM_DOMAIN->pChainSem);
  1286. X
  1287. X    pFinger = SHMEM_DOMAIN->pChannelChain;
  1288. X
  1289. X    while (pFinger) {
  1290. X    if (pFinger->iPort != iPort)
  1291. X        pFinger = pFinger->pNext;
  1292. X    else {
  1293. X        *hChannel = pFinger;
  1294. X        iErr = VEOS_SUCCESS;
  1295. X        break;
  1296. X        }
  1297. X    }
  1298. X
  1299. X    usvsema(SHMEM_DOMAIN->pChainSem);
  1300. X#endif
  1301. X
  1302. X    return(iErr);
  1303. X    }
  1304. X/****************************************************************************************/
  1305. END_OF_FILE
  1306. if test 8706 -ne `wc -c <'kernel_private/src/talk/shmem.c'`; then
  1307.     echo shar: \"'kernel_private/src/talk/shmem.c'\" unpacked with wrong size!
  1308. fi
  1309. # end of 'kernel_private/src/talk/shmem.c'
  1310. fi
  1311. if test -f 'src/include/world.h' -a "${1}" != "-c" ; then 
  1312.   echo shar: Will not clobber existing file \"'src/include/world.h'\"
  1313. else
  1314. echo shar: Extracting \"'src/include/world.h'\" \(7962 characters\)
  1315. sed "s/^X//" >'src/include/world.h' <<'END_OF_FILE'
  1316. X/****************************************************************************************
  1317. X * file: world.h                                    *
  1318. X *                                            *
  1319. X * May 18, 1991:  any veos code - kernel or prims - should use this include.        *
  1320. X *                                                    *
  1321. X * by Geoffrey P. Coco at the HITLab, Seattle.                          *
  1322. X *                                            *
  1323. X ****************************************************************************************/
  1324. X
  1325. X/****************************************************************************************
  1326. X * Copyright (C) 1992  Geoffrey P. Coco, Human Interface Technology Lab, Seattle    *
  1327. X ****************************************************************************************/
  1328. X
  1329. X
  1330. X/****************************************************************************************
  1331. X ** common includes **
  1332. X ****************************************************************************************/
  1333. X
  1334. X#include <stdio.h>
  1335. X#include <errno.h>
  1336. X#include <string.h>
  1337. X#include <sys/types.h>
  1338. X#include <sys/time.h>
  1339. X
  1340. X/****************************************************************************************
  1341. X ** common useful structures **
  1342. X ****************************************************************************************/
  1343. X
  1344. X
  1345. Xtypedef int        TVeosErr;   /* return type of all veos functions */
  1346. X
  1347. Xtypedef char        boolean;            
  1348. X
  1349. Xtypedef char        str63[63];
  1350. Xtypedef char        str15[15];
  1351. Xtypedef char        str255[255];
  1352. X
  1353. X
  1354. Xtypedef u_long        TTimeStamp, *TPTimeStamp, **THTimeStamp;
  1355. X
  1356. Xtypedef struct {
  1357. X    union {
  1358. X    float  f;
  1359. X    long   l;
  1360. X    } u;
  1361. X    } TF2L;
  1362. X
  1363. X/****************************************************************************************
  1364. X ** the grouple structure **
  1365. X ****************************************************************************************/
  1366. X
  1367. X/** grouple element types **/
  1368. X
  1369. X#define GR_unspecified    0
  1370. X
  1371. X#define GR_grouple    1
  1372. X#define GR_vector    2
  1373. X#define GR_float    3
  1374. X#define GR_int        4
  1375. X#define GR_prim        5
  1376. X#define GR_string    6
  1377. X
  1378. X#define GR_these    10
  1379. X#define GR_theseall    11
  1380. X#define GR_some        12
  1381. X#define GR_any               13
  1382. X#define GR_here        14
  1383. X
  1384. X#define GR_mark        15
  1385. X#define GR_touch    16
  1386. X
  1387. X
  1388. Xtypedef struct grouple     *TPGrouple;
  1389. Xtypedef struct grouple     **THGrouple;
  1390. X
  1391. X
  1392. Xtypedef struct {
  1393. X    int            iType;
  1394. X    union {
  1395. X    char        *pU;
  1396. X
  1397. X    char        *pS;
  1398. X    TPGrouple    pGr;
  1399. X
  1400. X    float        fVal;
  1401. X    int        iVal;
  1402. X
  1403. X    } u;
  1404. X
  1405. X    TTimeStamp        tLastMod;
  1406. X    int            iFlags;
  1407. X
  1408. X    } TElt,
  1409. X      *TPElt,
  1410. X      **THElt;
  1411. X
  1412. X
  1413. Xtypedef struct grouple {
  1414. X        int             iElts;
  1415. X        TElt            *pEltList;
  1416. X
  1417. X    int        iFlags;
  1418. X
  1419. X        } TGrouple;
  1420. X
  1421. X/****************************************************************************************
  1422. X ** common VEOS constants **
  1423. X ****************************************************************************************/
  1424. X
  1425. X#ifndef TRUE
  1426. X#define TRUE    1
  1427. X#endif
  1428. X
  1429. X#ifndef FALSE
  1430. X#define FALSE    0
  1431. X#endif
  1432. X
  1433. X#ifndef nil
  1434. X#define nil    0
  1435. X#endif
  1436. X
  1437. X/****************************************************************************************
  1438. X ** VEOS-wide return values **
  1439. X ****************************************************************************************/
  1440. X
  1441. X#define VEOS_FAILURE        -1       /* values of type TVeosErr */
  1442. X#define VEOS_NEUTRAL        0
  1443. X#define VEOS_SUCCESS        1
  1444. X
  1445. X#define VEOS_EOF        -2
  1446. X#define VEOS_MEM_ERR        -3
  1447. X#define VEOS_FILE_ERR        -4
  1448. X#define VEOS_DATA_ERR        -5
  1449. X
  1450. X/****************************************************************************************
  1451. X ** common Nancy constants **
  1452. X ****************************************************************************************/
  1453. X
  1454. X#define NANCY_LessThan            -217
  1455. X#define NANCY_GreaterThan        -218
  1456. X#define NANCY_EndOfGrouple        -220
  1457. X
  1458. X#define NANCY_MisplacedLeftBracket    -223
  1459. X#define NANCY_MisplacedRightBracket    -222
  1460. X#define NANCY_MissingRightBracket       -224
  1461. X
  1462. X#define NANCY_NoTypeMatch        -225
  1463. X#define NANCY_BadType            -226
  1464. X
  1465. X#define NANCY_MatchIncomplete        -229
  1466. X#define NANCY_MatchOne            -230
  1467. X#define NANCY_MatchMany            -231
  1468. X
  1469. X#define NANCY_CopyMatch            -232
  1470. X#define NANCY_RemoveMatch        -233
  1471. X#define NANCY_GimmeMatch        -234
  1472. X#define NANCY_ReplaceMatch        -235
  1473. X
  1474. X#define NANCY_NoMatch            -236
  1475. X#define NANCY_NotSupported        -237
  1476. X
  1477. X#define NANCY_SrcTooShort        -238
  1478. X#define NANCY_PatTooShort        -239
  1479. X
  1480. X#define NANCY_Explicit             -245
  1481. X#define NANCY_Implicit             -246
  1482. X
  1483. X/****************************************************************************************
  1484. X ** common Shell constants **
  1485. X ****************************************************************************************/
  1486. X
  1487. X
  1488. X
  1489. X/****************************************************************************************
  1490. X ** common Talk constants **
  1491. X ****************************************************************************************/
  1492. X
  1493. X#define TALK_BOGUS_FD    -1        /* real file descriptors are non-neg */
  1494. X#define TALK_BOGUS_HOST    -1
  1495. X#define TALK_BOGUS_PORT    -1
  1496. X
  1497. X/****************************************************************************************
  1498. X ** common useful macros **
  1499. X ****************************************************************************************/
  1500. X
  1501. X
  1502. X
  1503. X/** SunOS requires 4th-word alignment when allocating memory on Sun 4's 
  1504. X ** but other machines must use same scheme for network compatibility. 
  1505. X ** ... lowest common denominator ... 
  1506. X **/
  1507. X#define MEMSIZE(sz)  (((sz) + 3) & 0xFFFFFFFC)
  1508. X
  1509. X#define MALLOC(sz)  malloc(MEMSIZE(sz))
  1510. X#define REMALLOC(ptr, sz) realloc(ptr, MEMSIZE(sz))
  1511. X
  1512. X#define NEWPTR(ptr, type, size)  (ptr = (type) MALLOC(size))
  1513. X#define AGAINPTR(destptr, srcptr, type, size)  (destptr = (type) REMALLOC(srcptr, size))
  1514. X
  1515. X#define DELETE(var)      free((char *) var)
  1516. X#define DUMP(ptr)    free((char *) ptr)
  1517. X
  1518. X
  1519. X#define SETFLAG(flag, flagvar)        flagvar |= flag
  1520. X#define CLRFLAG(flag, flagvar)        flagvar &= ~flag
  1521. X#define TESTFLAG(flag, flagvar)        ((flag & flagvar) ? TRUE : FALSE)
  1522. X
  1523. X#define SAVE_FLAGS(flag, save)      { save = flag & NANCY_FlagMask;   \
  1524. X                     flag &= ~NANCY_FlagMask; }
  1525. X
  1526. X#define RESTORE_FLAGS(flag, save)   { flag |= save; }
  1527. X                    
  1528. X
  1529. X#define TIME_LESS_THAN(time1, time2)     (time1 < time2)
  1530. X
  1531. X#define CATCH_TRAP(iSignal, bTrapped) \
  1532. X    if (TRAP_FLAGS & 0x00000001 << iSignal) { \
  1533. X    TRAP_FLAGS = TRAP_FLAGS & ~(0x00000001 << iSignal); \
  1534. X    TERMINATE = FALSE; \
  1535. X    bTrapped = TRUE; \
  1536. X    } \
  1537. X    else \
  1538. X    bTrapped = FALSE;
  1539. X
  1540. X#define NANCY_EltMarkMask    0x40000000
  1541. X#define NANCY_EltMatchMask    0x20000000
  1542. X#define NANCY_EltTouchMask    0x10000000
  1543. X#define NANCY_FlagMask        0x70000000
  1544. X
  1545. X#define NANCY_MarkWithinMask     0x00000001
  1546. X#define NANCY_TouchWithinMask     0x00000008
  1547. X#define NANCY_ContentMask     0x00000002
  1548. X#define NANCY_VectorMask     0x00000004
  1549. X
  1550. X#define NEW_GROUPLE(pGrouple) \
  1551. X{ \
  1552. X    Nancy_NewGrouple(&pGrouple); \
  1553. X    }
  1554. X
  1555. X#define NEW_ELT(iType, pData, pElt) \
  1556. X{ \
  1557. X    Nancy_CreateElement(pElt, iType, 0); \
  1558. X    bcopy((char *) pData, pElt->u.pU, TYPE_SIZES[iType]); \
  1559. X    }
  1560. X
  1561. X#define INSERT_ELT(pGrouple, pElt, iLoc) \
  1562. X{ \
  1563. X    Nancy_NewElementsInGrouple(pGrouple, iLoc, 1, GR_unspecified, 0); \
  1564. X    pGrouple->pEltList[iLoc] = *pElt; \
  1565. X    }  
  1566. X
  1567. X#define charsymbolp(s, ch)      (symbolp(s) &&            \
  1568. X                getstring(getpname(s))[0] == ch &&    \
  1569. X                getstring(getpname(s))[1] == '\0')
  1570. X
  1571. X#define TIME2XELT(time, pElt) \
  1572. X{ \
  1573. X    TF2L       fTrans; \
  1574. X    fTrans.u.l = time; \
  1575. X    setflonum(pElt, fTrans.u.f); \
  1576. X    }
  1577. X
  1578. X
  1579. X#define XELT2TIME(pElt, time) \
  1580. X{ \
  1581. X    TF2L       fTrans; \
  1582. X    fTrans.u.f = getflonum(pElt); \
  1583. X    time = fTrans.u.l; \
  1584. X    }
  1585. X
  1586. X
  1587. X/****************************************************************************************
  1588. X ** public globals setup by the kernel **
  1589. X ****************************************************************************************/
  1590. X
  1591. X#ifdef MAIN_MODULE
  1592. Xstr63            Veos_sUid;
  1593. Xboolean            Veos_bTerminate;
  1594. X#else
  1595. Xextern str63        Veos_sUid;
  1596. Xextern boolean        Veos_bTerminate;
  1597. X#endif
  1598. X
  1599. X#define WHOAMI        Veos_sUid
  1600. X#define TERMINATE    Veos_bTerminate
  1601. X
  1602. X/****************************************************************************************
  1603. X ** C utils for prim programmers **
  1604. X ****************************************************************************************/
  1605. X
  1606. X#ifdef _DEC_
  1607. Xextern char *strdup();
  1608. X#endif
  1609. X
  1610. X/****************************************************************************************
  1611. X
  1612. X ****************************************************************************************/
  1613. X
  1614. X
  1615. END_OF_FILE
  1616. if test 7962 -ne `wc -c <'src/include/world.h'`; then
  1617.     echo shar: \"'src/include/world.h'\" unpacked with wrong size!
  1618. fi
  1619. # end of 'src/include/world.h'
  1620. fi
  1621. if test -f 'src/kernel_current/fern/fgod.lsp' -a "${1}" != "-c" ; then 
  1622.   echo shar: Will not clobber existing file \"'src/kernel_current/fern/fgod.lsp'\"
  1623. else
  1624. echo shar: Extracting \"'src/kernel_current/fern/fgod.lsp'\" \(9175 characters\)
  1625. sed "s/^X//" >'src/kernel_current/fern/fgod.lsp' <<'END_OF_FILE'
  1626. X;;-----------------------------------------------------------
  1627. X;; file: fgod.lsp
  1628. X;;
  1629. X;; FERN is the Fractal Entity Relativity Node.
  1630. X;; This file is the FGOD compenent of the Fern System.
  1631. X;;
  1632. X;; creation: February 28, 1992
  1633. X;;
  1634. X;; by Geoffrey P. Coco at the HITLab, Seattle
  1635. X;;-----------------------------------------------------------
  1636. X
  1637. X;;-----------------------------------------------------------
  1638. X;; Copyright (C) 1992  Geoffrey P. Coco,
  1639. X;; Human Interface Technology Lab, Seattle
  1640. X;;-----------------------------------------------------------
  1641. X
  1642. X
  1643. X;;-----------------------------------------------------------
  1644. X#|
  1645. X
  1646. XThese functions provide users of the Fern System with clean
  1647. Xand well-defined mechanisms for directly affecting other
  1648. Xentities.  They represent the god component of the the Fern
  1649. Xsystem (or FGOD).  The FGOD primarily administrates a common
  1650. Xprotocol for passing proactive instructions between entities.
  1651. X
  1652. X|#
  1653. X;;-----------------------------------------------------------
  1654. X;;            FGOD PUBLIC FUNCTIONS
  1655. X;;-----------------------------------------------------------
  1656. X
  1657. X
  1658. X;; fgod-make-node
  1659. X
  1660. X;; dynamically create an entity ... somewhere.
  1661. X;; pass which host where entity will run,
  1662. X;; the binary executable of the entity,
  1663. X;; and the lisp program for the entity to execute.
  1664. X;; all these args are strings; defaults are below.
  1665. X
  1666. X(defun fgod-make-node (&key (run-host (aref self 0))
  1667. X                (binary "entity")
  1668. X                (program "/home/veos/lisp/tabula_rasa")
  1669. X                (display-host (aref self 0)))
  1670. X  (progn
  1671. X
  1672. X    ;; make sure that entity can display locally
  1673. X    (cond ((equal display-host (aref self 0))
  1674. X       (cond ((not (equal run-host (aref self 0)))
  1675. X          (system (sprintf "xhost + " run-host))))))
  1676. X
  1677. X    ;; make unix call to launch remote entity
  1678. X    (system (fgod-rsh-command run-host binary program display-host))
  1679. X
  1680. X    ;; now, wait for reply of success
  1681. X    ;; this is handled remotely by fgod-be-node
  1682. X    (printf1 "waiting for offspring to respond...")
  1683. X
  1684. X    ;; this var gets set by new entity via remote proc call to us - 
  1685. X    ;; as part of it's startup protocol (see fgod-be-node)
  1686. X    (setq fern-descendent nil)
  1687. X
  1688. X    (read-time)
  1689. X    (do ((reply nil) (timer 0))
  1690. X    ((cond 
  1691. X
  1692. X      ;; the entity lives !!!
  1693. X      (fern-descendent
  1694. X       (printf1 "\noffspring was: " (uid2str fern-descendent))
  1695. X       (setq reply fern-descendent)
  1696. X       (setq fern-descendent nil)
  1697. X       t)
  1698. X
  1699. X      ;; new entity didn't respond in reasonable amount of time
  1700. X      ((> timer fgod-timeout)
  1701. X       (printf "\noffspring didn't respond.")
  1702. X       t))
  1703. X
  1704. X     reply)
  1705. X
  1706. X    ;; give time to persist procs and hope for reply message.
  1707. X    ;; reply is in the form: (setq fern-descendent new-entity-uid)
  1708. X    (fcon-time)
  1709. X
  1710. X    (setq timer (+ timer (read-time)))
  1711. X    )
  1712. X    ))
  1713. X
  1714. X;;-----------------------------------------------------------
  1715. X
  1716. X;; fgod-impart
  1717. X
  1718. X#|
  1719. Xarguments:
  1720. X     uid of desired entity and
  1721. X     *quoted* function call.
  1722. X
  1723. Xexecute remote lisp functions.
  1724. X
  1725. Xconsider this example of the proper way to use fgod-impart:
  1726. X
  1727. X    (fgod-implant #("iris2" 5503) `(fe-enter ,self))
  1728. X
  1729. Xthis call will cause the remote entity to 'enter' your entity as a
  1730. Xspace.  this can be used for smart portals.
  1731. X
  1732. Xwe quote the remote function call so that the function is finally
  1733. Xevaluated by the catcher of this message - not by the thrower.
  1734. X
  1735. Xnotice that the code we want to send contains a variable (i.e. self)
  1736. Xwhich we want to evaluate *before* the message is thrown.  we can use
  1737. Xthe 'backquote-comma' syntax as shown to do this.
  1738. X
  1739. Xhere is another, more complex example:
  1740. X
  1741. X   (fgod-impart #("iris2" 5503)
  1742. X         `(setq remote-var
  1743. X                        (list ,(+ local-x local-y) (+ remote-x remote-y))))
  1744. X
  1745. Xagain, we quote the entire message with backquote.  but we want to
  1746. Xevaluate the expression (+ local-x local-y) *before* throwing, thus
  1747. Xthe comma before this expression.
  1748. X
  1749. Xnotice that the second argument to setq is a call to (list ...).  this
  1750. Xis also passed on unevaluated to the catching entity.  when this
  1751. Xmessage is eventually evaluated, it will then create a list of the
  1752. Xalready computed (+ local-x local-y) value and the result of the
  1753. Xexpression (+ remote-x remote-y).
  1754. X
  1755. Xto restate, the (+ remote-x remote-y) is evaluated by the catcher of
  1756. Xthe message.  the (list ...) is so that the remote lisp will not try
  1757. Xto evaluate (<computed-val> (+ local-x local-y)) as a function call.
  1758. X
  1759. XNOTE: please use this function for remote entity editing, rather than
  1760. Xcalling vthrow yourself - in the future, this function will also throw
  1761. Xan ancestral password.  
  1762. X|#
  1763. X
  1764. X
  1765. X(defun fgod-impart (uid remote-func-call)
  1766. X  (vthrow (list uid) remote-func-call))
  1767. X
  1768. X;;-----------------------------------------------------------
  1769. X
  1770. X;; same as fgod-impart except that it holds and waits the
  1771. X;; the result of the remote function call.
  1772. X;; timeout is in seconds
  1773. X
  1774. X(defun fgod-seq-impart (uid remote-func-call)
  1775. X  (progn
  1776. X    (vthrow (list uid) `(fgod-seq-remote ,self ,remote-func-call))
  1777. X    
  1778. X    (setq fgod-seq-reply nil)
  1779. X    (read-time)
  1780. X    (do ((reply nil) (timer 0))
  1781. X
  1782. X    ((cond
  1783. X      
  1784. X      ;; the entity responded !!!
  1785. X      (fgod-seq-reply
  1786. X       ;; the remote entity will pass back the result inside an extra list.
  1787. X       ;; this is so we can distinguish between no reponse and a response of nil.
  1788. X       (setq reply (car fgod-seq-reply))
  1789. X       (setq fgod-seq-reply nil)
  1790. X       t)
  1791. X      
  1792. X      ;; entity didn't respond in adequate time
  1793. X      ((> timer fgod-timeout)
  1794. X       t))
  1795. X
  1796. X     reply)
  1797. X
  1798. X    ;; give time to persist procs and hope for reply message.
  1799. X    ;; reply is in the form: (setq fgod-seq-reply data)
  1800. X    (fcon-time)
  1801. X
  1802. X    (setq timer (+ timer (read-time)))
  1803. X    )
  1804. X    ))
  1805. X
  1806. X
  1807. X;;-----------------------------------------------------------
  1808. X
  1809. X
  1810. X;;-----------------------------------------------------------
  1811. X;;            FGOD PRIVATE FUNCTIONS
  1812. X;;-----------------------------------------------------------
  1813. X
  1814. X(defun fgod-init ()
  1815. X  ;; try to alert creator that we made it
  1816. X  (fgod-be-node)
  1817. X
  1818. X  (setq fgod-timeout 15)
  1819. X  )
  1820. X
  1821. X;;-----------------------------------------------------------
  1822. X
  1823. X;; generate command string to pass to unix which does:
  1824. X;; rsh to host,
  1825. X;; xterm with display to local screen,
  1826. X;; and run a chosen entity with a chosen startup program.
  1827. X
  1828. X(defun fgod-rsh-command (run-host binary program display-host)
  1829. X  (progn
  1830. X
  1831. X    (cond (fern-debug
  1832. X       (printf "run-host: " run-host)
  1833. X       (printf "binary: " binary)
  1834. X       (printf "program: " program)
  1835. X       (printf "display-host: " display-host)))
  1836. X    
  1837. X    (let (xterm-command
  1838. X      window-title
  1839. X      entity-command)
  1840. X      (setq
  1841. X       entity-command (sprintf
  1842. X               ;; xlisp binary to execute
  1843. X               binary
  1844. X               " "
  1845. X               ;; the ancestor bits
  1846. X               (fgod-ancestor-code)
  1847. X               " "
  1848. X               ;; the xlisp startup program
  1849. X               program
  1850. X               )
  1851. X       window-title (sprintf binary "@" run-host)
  1852. X       xterm-command (sprintf
  1853. X              ;; call xterm remotely
  1854. X              "xterm "
  1855. X              ;; xterm window coords
  1856. X              "-geometry "
  1857. X              (fgod-new-wind)
  1858. X              " "
  1859. X              ;; xwindow tricks
  1860. X              "-iconic "
  1861. X              ;; xterm window name
  1862. X              "-T "
  1863. X              window-title
  1864. X              " "
  1865. X              ;; display on chosen screen
  1866. X              (cond ((not (equal run-host display-host))
  1867. X                 (sprintf
  1868. X                  "-display "
  1869. X                  (fgod-host-xwindow display-host)
  1870. X                  " ")))
  1871. X              ;; the entity program
  1872. X              "-e "
  1873. X              entity-command))
  1874. X      
  1875. X      (cond 
  1876. X       ;; local case is simple, no rsh needed
  1877. X       ((equal run-host (aref self 0))
  1878. X    (sprintf
  1879. X     ;; the remote command
  1880. X     xterm-command
  1881. X     " "
  1882. X     ;; make this a local background process
  1883. X     "&"))
  1884. X       
  1885. X       ;; remote case, rsh the entire command
  1886. X       (t
  1887. X    (sprintf "rsh "
  1888. X         ;; where to rsh
  1889. X         run-host 
  1890. X         ;; don't pass this terminal's input to it.
  1891. X         " -n "
  1892. X         ;; the remote command
  1893. X         "\"" xterm-command "\" "
  1894. X         ;; make this a local background process
  1895. X         "&")))
  1896. X      )))
  1897. X
  1898. X;;-----------------------------------------------------------
  1899. X
  1900. X;; generate command string for X-window placement on screen.
  1901. X;; with repeated calls, this produces geometry for tiled windows.
  1902. X
  1903. X(defun fgod-new-wind ()
  1904. X  (progn
  1905. X    (cond ((boundp 'xwindow-place)
  1906. X       (setf (nth 1 xwindow-place) (- (nth 1 xwindow-place) 25))
  1907. X       (setf (nth 3 xwindow-place) (- (nth 3 xwindow-place) 25)))
  1908. X      (t
  1909. X       (setq xwindow-place '("76x15+" 430 "+" 640))))
  1910. X    (eval `(sprintf ,@xwindow-place))))
  1911. X
  1912. X
  1913. X;;-----------------------------------------------------------
  1914. X
  1915. X(defmacro fgod-ancestor-code ()
  1916. X  (sprintf "/home/veos/lisp/ancestors/" 
  1917. X       (aref self 0) "_" (aref self 1) ".lsp "))
  1918. X
  1919. X(defun fgod-host-xwindow (display-host)
  1920. X  (sprintf display-host ":0.0"))
  1921. X
  1922. X;;-----------------------------------------------------------
  1923. X
  1924. X;; the remote reply handler for fgod-seq-impart
  1925. X(defun fgod-seq-remote (sender-uid local-func-call)
  1926. X  ;; note the particular protocol, here.
  1927. X  ;; we send the reply inside an extra list.
  1928. X  ;; this is so that the remote caller (fgod-seq-impart) can
  1929. X  ;; distinguish between no response and a response of nil
  1930. X  (vthrow (list sender-uid) `(setq fgod-seq-reply '(,local-func-call))))
  1931. X
  1932. X;;-----------------------------------------------------------
  1933. X
  1934. X;; remote counterpart to fgod-make-node
  1935. X(defun fgod-be-node ()
  1936. X  (cond ((boundp 'fern-ancestor)
  1937. X     (printf "throwing to ancestor...")
  1938. X     (print (vthrow `(,fern-ancestor) `(setq fern-descendent ,self)))
  1939. X     t)))
  1940. X
  1941. X;;-----------------------------------------------------------
  1942. X
  1943. X
  1944. END_OF_FILE
  1945. if test 9175 -ne `wc -c <'src/kernel_current/fern/fgod.lsp'`; then
  1946.     echo shar: \"'src/kernel_current/fern/fgod.lsp'\" unpacked with wrong size!
  1947. fi
  1948. # end of 'src/kernel_current/fern/fgod.lsp'
  1949. fi
  1950. if test -f 'src/kernel_current/include/world.h' -a "${1}" != "-c" ; then 
  1951.   echo shar: Will not clobber existing file \"'src/kernel_current/include/world.h'\"
  1952. else
  1953. echo shar: Extracting \"'src/kernel_current/include/world.h'\" \(7962 characters\)
  1954. sed "s/^X//" >'src/kernel_current/include/world.h' <<'END_OF_FILE'
  1955. X/****************************************************************************************
  1956. X * file: world.h                                    *
  1957. X *                                            *
  1958. X * May 18, 1991:  any veos code - kernel or prims - should use this include.        *
  1959. X *                                                    *
  1960. X * by Geoffrey P. Coco at the HITLab, Seattle.                          *
  1961. X *                                            *
  1962. X ****************************************************************************************/
  1963. X
  1964. X/****************************************************************************************
  1965. X * Copyright (C) 1992  Geoffrey P. Coco, Human Interface Technology Lab, Seattle    *
  1966. X ****************************************************************************************/
  1967. X
  1968. X
  1969. X/****************************************************************************************
  1970. X ** common includes **
  1971. X ****************************************************************************************/
  1972. X
  1973. X#include <stdio.h>
  1974. X#include <errno.h>
  1975. X#include <string.h>
  1976. X#include <sys/types.h>
  1977. X#include <sys/time.h>
  1978. X
  1979. X/****************************************************************************************
  1980. X ** common useful structures **
  1981. X ****************************************************************************************/
  1982. X
  1983. X
  1984. Xtypedef int        TVeosErr;   /* return type of all veos functions */
  1985. X
  1986. Xtypedef char        boolean;            
  1987. X
  1988. Xtypedef char        str63[63];
  1989. Xtypedef char        str15[15];
  1990. Xtypedef char        str255[255];
  1991. X
  1992. X
  1993. Xtypedef u_long        TTimeStamp, *TPTimeStamp, **THTimeStamp;
  1994. X
  1995. Xtypedef struct {
  1996. X    union {
  1997. X    float  f;
  1998. X    long   l;
  1999. X    } u;
  2000. X    } TF2L;
  2001. X
  2002. X/****************************************************************************************
  2003. X ** the grouple structure **
  2004. X ****************************************************************************************/
  2005. X
  2006. X/** grouple element types **/
  2007. X
  2008. X#define GR_unspecified    0
  2009. X
  2010. X#define GR_grouple    1
  2011. X#define GR_vector    2
  2012. X#define GR_float    3
  2013. X#define GR_int        4
  2014. X#define GR_prim        5
  2015. X#define GR_string    6
  2016. X
  2017. X#define GR_these    10
  2018. X#define GR_theseall    11
  2019. X#define GR_some        12
  2020. X#define GR_any               13
  2021. X#define GR_here        14
  2022. X
  2023. X#define GR_mark        15
  2024. X#define GR_touch    16
  2025. X
  2026. X
  2027. Xtypedef struct grouple     *TPGrouple;
  2028. Xtypedef struct grouple     **THGrouple;
  2029. X
  2030. X
  2031. Xtypedef struct {
  2032. X    int            iType;
  2033. X    union {
  2034. X    char        *pU;
  2035. X
  2036. X    char        *pS;
  2037. X    TPGrouple    pGr;
  2038. X
  2039. X    float        fVal;
  2040. X    int        iVal;
  2041. X
  2042. X    } u;
  2043. X
  2044. X    TTimeStamp        tLastMod;
  2045. X    int            iFlags;
  2046. X
  2047. X    } TElt,
  2048. X      *TPElt,
  2049. X      **THElt;
  2050. X
  2051. X
  2052. Xtypedef struct grouple {
  2053. X        int             iElts;
  2054. X        TElt            *pEltList;
  2055. X
  2056. X    int        iFlags;
  2057. X
  2058. X        } TGrouple;
  2059. X
  2060. X/****************************************************************************************
  2061. X ** common VEOS constants **
  2062. X ****************************************************************************************/
  2063. X
  2064. X#ifndef TRUE
  2065. X#define TRUE    1
  2066. X#endif
  2067. X
  2068. X#ifndef FALSE
  2069. X#define FALSE    0
  2070. X#endif
  2071. X
  2072. X#ifndef nil
  2073. X#define nil    0
  2074. X#endif
  2075. X
  2076. X/****************************************************************************************
  2077. X ** VEOS-wide return values **
  2078. X ****************************************************************************************/
  2079. X
  2080. X#define VEOS_FAILURE        -1       /* values of type TVeosErr */
  2081. X#define VEOS_NEUTRAL        0
  2082. X#define VEOS_SUCCESS        1
  2083. X
  2084. X#define VEOS_EOF        -2
  2085. X#define VEOS_MEM_ERR        -3
  2086. X#define VEOS_FILE_ERR        -4
  2087. X#define VEOS_DATA_ERR        -5
  2088. X
  2089. X/****************************************************************************************
  2090. X ** common Nancy constants **
  2091. X ****************************************************************************************/
  2092. X
  2093. X#define NANCY_LessThan            -217
  2094. X#define NANCY_GreaterThan        -218
  2095. X#define NANCY_EndOfGrouple        -220
  2096. X
  2097. X#define NANCY_MisplacedLeftBracket    -223
  2098. X#define NANCY_MisplacedRightBracket    -222
  2099. X#define NANCY_MissingRightBracket       -224
  2100. X
  2101. X#define NANCY_NoTypeMatch        -225
  2102. X#define NANCY_BadType            -226
  2103. X
  2104. X#define NANCY_MatchIncomplete        -229
  2105. X#define NANCY_MatchOne            -230
  2106. X#define NANCY_MatchMany            -231
  2107. X
  2108. X#define NANCY_CopyMatch            -232
  2109. X#define NANCY_RemoveMatch        -233
  2110. X#define NANCY_GimmeMatch        -234
  2111. X#define NANCY_ReplaceMatch        -235
  2112. X
  2113. X#define NANCY_NoMatch            -236
  2114. X#define NANCY_NotSupported        -237
  2115. X
  2116. X#define NANCY_SrcTooShort        -238
  2117. X#define NANCY_PatTooShort        -239
  2118. X
  2119. X#define NANCY_Explicit             -245
  2120. X#define NANCY_Implicit             -246
  2121. X
  2122. X/****************************************************************************************
  2123. X ** common Shell constants **
  2124. X ****************************************************************************************/
  2125. X
  2126. X
  2127. X
  2128. X/****************************************************************************************
  2129. X ** common Talk constants **
  2130. X ****************************************************************************************/
  2131. X
  2132. X#define TALK_BOGUS_FD    -1        /* real file descriptors are non-neg */
  2133. X#define TALK_BOGUS_HOST    -1
  2134. X#define TALK_BOGUS_PORT    -1
  2135. X
  2136. X/****************************************************************************************
  2137. X ** common useful macros **
  2138. X ****************************************************************************************/
  2139. X
  2140. X
  2141. X
  2142. X/** SunOS requires 4th-word alignment when allocating memory on Sun 4's 
  2143. X ** but other machines must use same scheme for network compatibility. 
  2144. X ** ... lowest common denominator ... 
  2145. X **/
  2146. X#define MEMSIZE(sz)  (((sz) + 3) & 0xFFFFFFFC)
  2147. X
  2148. X#define MALLOC(sz)  malloc(MEMSIZE(sz))
  2149. X#define REMALLOC(ptr, sz) realloc(ptr, MEMSIZE(sz))
  2150. X
  2151. X#define NEWPTR(ptr, type, size)  (ptr = (type) MALLOC(size))
  2152. X#define AGAINPTR(destptr, srcptr, type, size)  (destptr = (type) REMALLOC(srcptr, size))
  2153. X
  2154. X#define DELETE(var)      free((char *) var)
  2155. X#define DUMP(ptr)    free((char *) ptr)
  2156. X
  2157. X
  2158. X#define SETFLAG(flag, flagvar)        flagvar |= flag
  2159. X#define CLRFLAG(flag, flagvar)        flagvar &= ~flag
  2160. X#define TESTFLAG(flag, flagvar)        ((flag & flagvar) ? TRUE : FALSE)
  2161. X
  2162. X#define SAVE_FLAGS(flag, save)      { save = flag & NANCY_FlagMask;   \
  2163. X                     flag &= ~NANCY_FlagMask; }
  2164. X
  2165. X#define RESTORE_FLAGS(flag, save)   { flag |= save; }
  2166. X                    
  2167. X
  2168. X#define TIME_LESS_THAN(time1, time2)     (time1 < time2)
  2169. X
  2170. X#define CATCH_TRAP(iSignal, bTrapped) \
  2171. X    if (TRAP_FLAGS & 0x00000001 << iSignal) { \
  2172. X    TRAP_FLAGS = TRAP_FLAGS & ~(0x00000001 << iSignal); \
  2173. X    TERMINATE = FALSE; \
  2174. X    bTrapped = TRUE; \
  2175. X    } \
  2176. X    else \
  2177. X    bTrapped = FALSE;
  2178. X
  2179. X#define NANCY_EltMarkMask    0x40000000
  2180. X#define NANCY_EltMatchMask    0x20000000
  2181. X#define NANCY_EltTouchMask    0x10000000
  2182. X#define NANCY_FlagMask        0x70000000
  2183. X
  2184. X#define NANCY_MarkWithinMask     0x00000001
  2185. X#define NANCY_TouchWithinMask     0x00000008
  2186. X#define NANCY_ContentMask     0x00000002
  2187. X#define NANCY_VectorMask     0x00000004
  2188. X
  2189. X#define NEW_GROUPLE(pGrouple) \
  2190. X{ \
  2191. X    Nancy_NewGrouple(&pGrouple); \
  2192. X    }
  2193. X
  2194. X#define NEW_ELT(iType, pData, pElt) \
  2195. X{ \
  2196. X    Nancy_CreateElement(pElt, iType, 0); \
  2197. X    bcopy((char *) pData, pElt->u.pU, TYPE_SIZES[iType]); \
  2198. X    }
  2199. X
  2200. X#define INSERT_ELT(pGrouple, pElt, iLoc) \
  2201. X{ \
  2202. X    Nancy_NewElementsInGrouple(pGrouple, iLoc, 1, GR_unspecified, 0); \
  2203. X    pGrouple->pEltList[iLoc] = *pElt; \
  2204. X    }  
  2205. X
  2206. X#define charsymbolp(s, ch)      (symbolp(s) &&            \
  2207. X                getstring(getpname(s))[0] == ch &&    \
  2208. X                getstring(getpname(s))[1] == '\0')
  2209. X
  2210. X#define TIME2XELT(time, pElt) \
  2211. X{ \
  2212. X    TF2L       fTrans; \
  2213. X    fTrans.u.l = time; \
  2214. X    setflonum(pElt, fTrans.u.f); \
  2215. X    }
  2216. X
  2217. X
  2218. X#define XELT2TIME(pElt, time) \
  2219. X{ \
  2220. X    TF2L       fTrans; \
  2221. X    fTrans.u.f = getflonum(pElt); \
  2222. X    time = fTrans.u.l; \
  2223. X    }
  2224. X
  2225. X
  2226. X/****************************************************************************************
  2227. X ** public globals setup by the kernel **
  2228. X ****************************************************************************************/
  2229. X
  2230. X#ifdef MAIN_MODULE
  2231. Xstr63            Veos_sUid;
  2232. Xboolean            Veos_bTerminate;
  2233. X#else
  2234. Xextern str63        Veos_sUid;
  2235. Xextern boolean        Veos_bTerminate;
  2236. X#endif
  2237. X
  2238. X#define WHOAMI        Veos_sUid
  2239. X#define TERMINATE    Veos_bTerminate
  2240. X
  2241. X/****************************************************************************************
  2242. X ** C utils for prim programmers **
  2243. X ****************************************************************************************/
  2244. X
  2245. X#ifdef _DEC_
  2246. Xextern char *strdup();
  2247. X#endif
  2248. X
  2249. X/****************************************************************************************
  2250. X
  2251. X ****************************************************************************************/
  2252. X
  2253. X
  2254. END_OF_FILE
  2255. if test 7962 -ne `wc -c <'src/kernel_current/include/world.h'`; then
  2256.     echo shar: \"'src/kernel_current/include/world.h'\" unpacked with wrong size!
  2257. fi
  2258. # end of 'src/kernel_current/include/world.h'
  2259. fi
  2260. if test -f 'src/kernel_current/talk/shmem.c' -a "${1}" != "-c" ; then 
  2261.   echo shar: Will not clobber existing file \"'src/kernel_current/talk/shmem.c'\"
  2262. else
  2263. echo shar: Extracting \"'src/kernel_current/talk/shmem.c'\" \(8706 characters\)
  2264. sed "s/^X//" >'src/kernel_current/talk/shmem.c' <<'END_OF_FILE'
  2265. X/****************************************************************************************
  2266. X *                                            *
  2267. X * file: ShMem.c                                                *
  2268. X *                                            *
  2269. X * April 6, 1992: The shared memory handler for the Talk module of VEOS            *
  2270. X *                                            *
  2271. X * by Geoffrey P. Coco at the HITLab, Seattle.                          *
  2272. X *                                            *
  2273. X ****************************************************************************************/
  2274. X
  2275. X/****************************************************************************************
  2276. X * Copyright (C) 1992  Geoffrey P. Coco, Human Interface Technology Lab, Seattle    *
  2277. X ****************************************************************************************/
  2278. X
  2279. X
  2280. X/****************************************************************************************
  2281. X *                      include the papa include file                */
  2282. X
  2283. X#include "kernel.h"
  2284. X#include <signal.h>
  2285. X
  2286. X/****************************************************************************************/
  2287. X
  2288. X
  2289. X
  2290. X/****************************************************************************************/
  2291. XTVeosErr ShMem_Init()
  2292. X{
  2293. X    TVeosErr        iErr;
  2294. X    boolean        bTrap;
  2295. X    str255        sSave;
  2296. X
  2297. X    iErr = VEOS_SUCCESS;
  2298. X
  2299. X#ifdef _SG_
  2300. X    usconfig(CONF_INITSIZE, SHMEM_SHARED_BUF_SIZE);
  2301. X    
  2302. X    iErr = SHMEM_INIT_ERR;
  2303. X
  2304. X    SHMEM_ARENA = usinit(SHMEM_ARENA_FILE);
  2305. X
  2306. X    CATCH_TRAP(SIGBUS, bTrap);
  2307. X    if (bTrap || (SHMEM_ARENA == nil)) {
  2308. X    strcpy(sSave, "/bin/rm/ -f ");
  2309. X    strcat(sSave, SHMEM_ARENA_FILE);
  2310. X    system(sSave);
  2311. X    SHMEM_ARENA = usinit(SHMEM_ARENA_FILE);
  2312. X    }
  2313. X
  2314. X    if (TALK_BUGS)
  2315. X    fprintf(stderr, "talk %s: attaching to shared memory arena %s\n",
  2316. X        WHOAMI, SHMEM_ARENA ? "was successful" : "failed");
  2317. X    
  2318. X    if (SHMEM_ARENA) {
  2319. X    
  2320. X    SHMEM_DOMAIN = usgetinfo(SHMEM_ARENA);
  2321. X    
  2322. X    if (TALK_BUGS)
  2323. X        fprintf(stderr, "talk %s: veos communication domain %s\n", 
  2324. X            WHOAMI, SHMEM_DOMAIN ? "found" : "not found, creating one...");
  2325. X
  2326. X    if (SHMEM_DOMAIN == nil) {
  2327. X        /** first entity on this machine,
  2328. X         ** initialize the shmem domain
  2329. X         **/
  2330. X        
  2331. X        chmod(SHMEM_ARENA_FILE, 0777);
  2332. X        
  2333. X        iErr = VEOS_MEM_ERR;
  2334. X        SHMEM_DOMAIN = usmalloc(sizeof(TShDomainRec), SHMEM_ARENA);
  2335. X        
  2336. X        if (SHMEM_DOMAIN) {
  2337. X        
  2338. X        SHMEM_DOMAIN->pChainSem = usnewsema(SHMEM_ARENA, 1);
  2339. X        SHMEM_DOMAIN->pChannelChain = nil;
  2340. X        
  2341. X        usputinfo(SHMEM_ARENA, SHMEM_DOMAIN);
  2342. X        }
  2343. X        }
  2344. X
  2345. X    
  2346. X    if (SHMEM_DOMAIN) {
  2347. X        
  2348. X        if (TALK_BUGS)
  2349. X        fprintf(stderr, "talk %s: creating memory listen channel...\n", WHOAMI);
  2350. X        
  2351. X        iErr = VEOS_MEM_ERR;
  2352. X        SHMEM_CHANNEL = usmalloc(sizeof(TSharedRec), SHMEM_ARENA);
  2353. X
  2354. X        if (SHMEM_CHANNEL) {
  2355. X        
  2356. X        SHMEM_CHANNEL->iPort = IDENT_ADDR.iPort;
  2357. X        SHMEM_CHANNEL->pSem = usnewsema(SHMEM_ARENA, 1);
  2358. X        SHMEM_CHANNEL->pAvail = &SHMEM_CHANNEL->pBuffer[0];
  2359. X        SHMEM_CHANNEL->pEnd = &SHMEM_CHANNEL->pBuffer[0] + SHMEM_RW_BUF_SIZE;
  2360. X        
  2361. X        
  2362. X        /** link new entity channel into shared domain record **/
  2363. X        
  2364. X        uspsema(SHMEM_DOMAIN->pChainSem);
  2365. X        
  2366. X        SHMEM_CHANNEL->pNext = SHMEM_DOMAIN->pChannelChain;
  2367. X        SHMEM_DOMAIN->pChannelChain = SHMEM_CHANNEL;
  2368. X        
  2369. X        usvsema(SHMEM_DOMAIN->pChainSem);
  2370. X        
  2371. X        iErr = VEOS_SUCCESS;
  2372. X        }
  2373. X        }
  2374. X    }
  2375. X#endif
  2376. X
  2377. X    return(iErr);
  2378. X
  2379. X    } /* ShMem_Init */
  2380. X/****************************************************************************************/
  2381. X
  2382. X
  2383. X
  2384. X/****************************************************************************************/
  2385. XTVeosErr ShMem_Close()
  2386. X{
  2387. X    TVeosErr           iErr;
  2388. X    boolean        bLast = FALSE;
  2389. X    THSharedRec        hFinger;
  2390. X    TPSharedRec        pSaveLink;
  2391. X    TPSemaphor        pSaveSem;
  2392. X
  2393. X    iErr = VEOS_SUCCESS;
  2394. X
  2395. X#ifdef _SG_
  2396. X    /** stop others from looking at the channel chain **/
  2397. X    uspsema(SHMEM_DOMAIN->pChainSem);
  2398. X
  2399. X    /** this channel is about to vanish
  2400. X     ** wait for others to finish looking at this channel
  2401. X     **/
  2402. X    pSaveSem = SHMEM_CHANNEL->pSem;
  2403. X    uspsema(pSaveSem);
  2404. X
  2405. X    /** find our channel in the domain channel chain, 
  2406. X     ** remove it, recoupling the links, and free the memory
  2407. X     **/
  2408. X    hFinger = &SHMEM_DOMAIN->pChannelChain;
  2409. X    while (*hFinger) {
  2410. X
  2411. X    if (*hFinger == SHMEM_CHANNEL) {
  2412. X        pSaveLink = (*hFinger)->pNext;
  2413. X        usfree(*hFinger, SHMEM_ARENA);
  2414. X        *hFinger = pSaveLink;
  2415. X        break;
  2416. X        }
  2417. X    hFinger = &(*hFinger)->pNext;
  2418. X    }
  2419. X
  2420. X    /** release and remove the channel semaphore **/
  2421. X    usvsema(pSaveSem);
  2422. X    usfreesema(pSaveSem, SHMEM_ARENA);
  2423. X
  2424. X    if (SHMEM_DOMAIN->pChannelChain == nil)
  2425. X    bLast = TRUE;
  2426. X
  2427. X    /** allow others to cleanly find no channel **/
  2428. X    usvsema(SHMEM_DOMAIN->pChainSem);
  2429. X    
  2430. X    if (bLast) {
  2431. X    usfreesema(SHMEM_DOMAIN->pChainSem, SHMEM_ARENA);
  2432. X    usfree(SHMEM_DOMAIN, SHMEM_ARENA);
  2433. X    unlink(SHMEM_ARENA_FILE);
  2434. X    }
  2435. X#endif
  2436. X
  2437. X    return(iErr);
  2438. X
  2439. X    } /* ShMem_Close */
  2440. X/****************************************************************************************/
  2441. X
  2442. X
  2443. X
  2444. X/****************************************************************************************/
  2445. XTVeosErr ShMem_WriteMessages(pSpeakNode)
  2446. X    TPSpeakNode        pSpeakNode;
  2447. X{
  2448. X    TVeosErr        iErr = VEOS_FAILURE;
  2449. X    int            iLen;
  2450. X    TPMessageNode    pSaveLink;
  2451. X    char        *sMessage;
  2452. X    TPSharedRec        pWriteChannel;
  2453. X
  2454. X
  2455. X#ifdef _SG_
  2456. X    iErr = ShMem_FindChannel(pSpeakNode->destRec.iPort, &pWriteChannel);
  2457. X
  2458. X    if (iErr != VEOS_SUCCESS)
  2459. X    iErr = TALK_CONN_CLOSED;
  2460. X
  2461. X    else {
  2462. X
  2463. X    /** dispatch message sending...             
  2464. X     ** oldest jobs first to enforce sequencing
  2465. X     **/        
  2466. X    
  2467. X    do {
  2468. X        /** attempt to transmit oldest message **/
  2469. X        
  2470. X        sMessage = pSpeakNode->pMessageQ->sMessage;
  2471. X        iLen = pSpeakNode->pMessageQ->iMsgLen;
  2472. X        
  2473. X
  2474. X
  2475. X        /** wait for exclusive rights to memory channel **/
  2476. X
  2477. X        uspsema(pWriteChannel->pSem);
  2478. X
  2479. X
  2480. X
  2481. X        /** check for available space in buffer **/
  2482. X#ifndef OPTIMAL        
  2483. X        if (TALK_BUGS) {
  2484. X        fprintf(stderr, "speak %s: buffer has %d bytes avail.\n",
  2485. X            WHOAMI, pWriteChannel->pEnd - pWriteChannel->pAvail);
  2486. X        }
  2487. X#endif
  2488. X        if (pWriteChannel->pAvail + iLen > pWriteChannel->pEnd)
  2489. X        iErr = SHMEM_FULL;
  2490. X
  2491. X        else {
  2492. X        /** write the message **/
  2493. X            
  2494. X        bcopy(sMessage, pWriteChannel->pAvail, iLen);
  2495. X        pWriteChannel->pAvail += iLen;
  2496. X#ifndef OPTIMAL
  2497. X        if (TALK_BUGS)
  2498. X            fprintf(stderr, "speak %s: wrote message, length: %d\n",
  2499. X                WHOAMI, iLen);
  2500. X#endif
  2501. X        }
  2502. X
  2503. X        /** give up rights to memory channel **/
  2504. X
  2505. X        usvsema(pWriteChannel->pSem);
  2506. X
  2507. X
  2508. X        if (iErr == VEOS_SUCCESS) {
  2509. X
  2510. X        /** dequeue this message from connection record **/
  2511. X        
  2512. X        DUMP(sMessage);
  2513. X        
  2514. X        
  2515. X        pSaveLink = pSpeakNode->pMessageQ->pLink;
  2516. X        Shell_ReturnBlock(pSpeakNode->pMessageQ,
  2517. X                  sizeof(TMessageNode), "message node");
  2518. X        pSpeakNode->pMessageQ = pSaveLink;
  2519. X        }
  2520. X
  2521. X        } while (pSpeakNode->pMessageQ && iErr == VEOS_SUCCESS);
  2522. X    }
  2523. X
  2524. X#endif
  2525. X
  2526. X    return(iErr);
  2527. X
  2528. X    } /* ShMem_WriteMessages */
  2529. X/****************************************************************************************/
  2530. X
  2531. X
  2532. X
  2533. X
  2534. X/****************************************************************************************/
  2535. XTVeosErr ShMem_GatherMessages()
  2536. X{
  2537. X    TVeosErr        iErr = VEOS_SUCCESS;
  2538. X    char        *pFinger;
  2539. X    TMsgRec        pbMsg;
  2540. X
  2541. X#ifdef _SG_
  2542. X    uspsema(SHMEM_CHANNEL->pSem);
  2543. X    
  2544. X    /** check for any data in buffer **/
  2545. X    if (SHMEM_CHANNEL->pAvail > SHMEM_CHANNEL->pBuffer) {
  2546. X    
  2547. X    pFinger = SHMEM_CHANNEL->pBuffer;
  2548. X    while (pFinger < SHMEM_CHANNEL->pAvail) {
  2549. X
  2550. X        pbMsg.iLen = ((int *) pFinger)[0];
  2551. X        pFinger += 4;
  2552. X        pbMsg.sMessage = pFinger;
  2553. X        
  2554. X        (*TALK_MSG_FUNC) (&pbMsg);
  2555. X
  2556. X        pFinger += pbMsg.iLen;
  2557. X        }
  2558. X    
  2559. X    /** mark buffer empty again **/
  2560. X    SHMEM_CHANNEL->pAvail = SHMEM_CHANNEL->pBuffer;
  2561. X    }
  2562. X
  2563. X    usvsema(SHMEM_CHANNEL->pSem);
  2564. X#endif
  2565. X
  2566. X    return(iErr);
  2567. X
  2568. X    } /* ShMem_GatherMessages */
  2569. X/****************************************************************************************/
  2570. X
  2571. X
  2572. X
  2573. X
  2574. X/****************************************************************************************/
  2575. Xboolean ShMem_CanShareMem(pUid)
  2576. X    TPUid    pUid;
  2577. X{
  2578. X    boolean    bSharedMem = FALSE;
  2579. X
  2580. X#ifdef _SG_
  2581. X    if (pUid->lHost == IDENT_ADDR.lHost &&
  2582. X    pUid->iPort != IDENT_ADDR.iPort)
  2583. X    bSharedMem = TRUE;
  2584. X#endif
  2585. X
  2586. X    return(bSharedMem);
  2587. X
  2588. X    } /* ShMem_CanShareMem */
  2589. X/****************************************************************************************/
  2590. X
  2591. X
  2592. X
  2593. X/****************************************************************************************/
  2594. XTVeosErr ShMem_FindChannel(iPort, hChannel)
  2595. X    int            iPort;
  2596. X    THSharedRec        hChannel;
  2597. X{
  2598. X    TVeosErr        iErr = VEOS_FAILURE;
  2599. X    TPSharedRec        pFinger;
  2600. X
  2601. X    *hChannel = nil;
  2602. X
  2603. X#ifdef _SG_
  2604. X    /** find channel for this destination **/
  2605. X    
  2606. X    uspsema(SHMEM_DOMAIN->pChainSem);
  2607. X
  2608. X    pFinger = SHMEM_DOMAIN->pChannelChain;
  2609. X
  2610. X    while (pFinger) {
  2611. X    if (pFinger->iPort != iPort)
  2612. X        pFinger = pFinger->pNext;
  2613. X    else {
  2614. X        *hChannel = pFinger;
  2615. X        iErr = VEOS_SUCCESS;
  2616. X        break;
  2617. X        }
  2618. X    }
  2619. X
  2620. X    usvsema(SHMEM_DOMAIN->pChainSem);
  2621. X#endif
  2622. X
  2623. X    return(iErr);
  2624. X    }
  2625. X/****************************************************************************************/
  2626. END_OF_FILE
  2627. if test 8706 -ne `wc -c <'src/kernel_current/talk/shmem.c'`; then
  2628.     echo shar: \"'src/kernel_current/talk/shmem.c'\" unpacked with wrong size!
  2629. fi
  2630. # end of 'src/kernel_current/talk/shmem.c'
  2631. fi
  2632. if test -f 'src/xlisp/xcore/c/ChangeLog' -a "${1}" != "-c" ; then 
  2633.   echo shar: Will not clobber existing file \"'src/xlisp/xcore/c/ChangeLog'\"
  2634. else
  2635. echo shar: Extracting \"'src/xlisp/xcore/c/ChangeLog'\" \(8739 characters\)
  2636. sed "s/^X//" >'src/xlisp/xcore/c/ChangeLog' <<'END_OF_FILE'
  2637. XWed Feb 12 14:32:10 1992  Andrew MacDonald  (awm at hitl.washington.edu)
  2638. X
  2639. X    * added vector case to equal primative.
  2640. X
  2641. XAny Jan XX XX:XX:XX 1992  Voodoo (voodoo at hitl.washington.edu)
  2642. X
  2643. X        * setup xlisp as a library.  an optional software tool.
  2644. X          rather than the mandatory command module.
  2645. X        * removed main from xlisp.  xlisp entry now called xmain().
  2646. X        * xmain.c contains the func xmain which acts just like the old main.
  2647. X          the differenc is that now xlisp is compiled once as a library
  2648. X          and linked to many software tools with respective mains.
  2649. X        * added xlfinit() which sets up the xlisp function table.
  2650. X          it places the tabel in the heap rather than in global stack space.
  2651. X        * also, user defined lisp functions are included at runtime rather
  2652. X          than at compile time.  again, xlisp does not need to be recompiled
  2653. X          to link with other software tools - even if there are user defined
  2654. X          xlisp functions.
  2655. X
  2656. XSun Jun 16 13:57:05 1991  Jeff Prothero  (jsp at glia)
  2657. X
  2658. X    * xlobj.c xsendmsg0/2/3() created.
  2659. X
  2660. XSat Jun 15 22:18:25 1991  Jeff Prothero  (jsp at glia.biostr.washington.edu)
  2661. X
  2662. X    * xlobj.c xsendmsg1() created.
  2663. X
  2664. XThu Jan 17 12:30:00 1991  Jeff Prothero  (jsp at glia.biostr.washington.edu)
  2665. X
  2666. X    * xldmem.c:gc() bugfix:  Bind s_gchook to NIL while
  2667. X      evaluating hook fn.  (This fix courtesy Tom Almy.)
  2668. X
  2669. X    * xldmem.c:gc() bugfix:  Do
  2670. X              if (nfree < (long)anodes)   addseg();
  2671. X      in gc() before *GC-HOOK* code, instead of in findmem().
  2672. X      Eliminate findmem(), which no longer serves any purpose.
  2673. X
  2674. X    * xlinit.c:xlsymbols() bugfix: Do
  2675. X          "setvalue(s_gchook,NIL);" *immediately* after
  2676. X          "s_gchook = xlenter("*GC-HOOK*");"
  2677. X
  2678. X
  2679. XFri Dec 14 11:23:07 1990  Jeff Prothero  (jsp at glia.biostr.washington.edu)
  2680. X
  2681. X    * Renamed ~/modules.h to ~/xmodules.h, adopting a uniform
  2682. X    convention that the xlisp-interface files in a module have
  2683. X    names starting with 'x' -- and the normal C files (useful
  2684. X    even in the absence of xlisp) do not.
  2685. X
  2686. XThu Dec 13 00:02:11 1990  Jeff Prothero  (jsp at glia)
  2687. X
  2688. X    * Split MODULE_XLFTAB_C_FUNTAB
  2689. X      into  MODULE_XLFTAB_C_FUNTAB_S
  2690. X      and   MODULE_XLFTAB_C_FUNTAB_F,
  2691. X      to reduce future problems porting modules to a
  2692. X      mooted xscheme-derived xlisp core.
  2693. X
  2694. XWed Dec 12 23:02:52 1990  Jeff Prothero  (jsp at glia)
  2695. X
  2696. X    * Renamed ~/xcore/src/xlhybrid.h   to ~/modules.h.
  2697. X    * Renamed ~/xcore/src/hybrid.h     to ~/xcore/doc/mymodule.h.
  2698. X    * Renamed ~/xcore/src/gobject.[ch] to ~/gobject/src/gobject.[ch].
  2699. X    * Moved   ~/xcore/test/gobject.lsp to ~/gobject/test/gobject.lsp.
  2700. X
  2701. XTue Dec  4 12:18:19 1990  Jeff Prothero  (jsp at glia)
  2702. X
  2703. X    * Added xlbadinit for bad initializer lists.
  2704. X
  2705. XWed Nov 28 13:13:27 1990  Jeff Prothero  (jsp at glia)
  2706. X
  2707. X    * xlobj.c:sendmsg() renamed to x_sendmsg() to eliminate conflict with
  2708. X        unix-socket sendmsg() fn, added xsendmsg() fn for hybrid classes
  2709. X    to call.
  2710. X
  2711. X    * xlobj.c "class"  renamed to "cls_class".
  2712. X      xlobj.c "object" renamed to "cls_object".
  2713. X          xlobj.c now exports s_self, k_new, k_isnew, cls_class and
  2714. X      cls_object, for benefit of hybrid classes which want to,
  2715. X          say, send a k_new message to cls_class.
  2716. X
  2717. XMon Nov 26 15:32:58 1990  Jeff Prothero  (jsp at glia)
  2718. X
  2719. X    * Killed 'LOCAL' on xlobj.c:getivcnt(), for gobject.c:gobshowI().
  2720. X
  2721. X    * Moved #defines for MESSAGES,IVARS,CVARS,CVALS,
  2722. X        SUPERCLASS,IVARCNT,IVARTOTAL from xlobj.c to xlisp.h,
  2723. X        so hybrid classes can access them easily.
  2724. X
  2725. XFri Nov 23 12:58:49 1990  Jeff Prothero  (jsp at glia)
  2726. X
  2727. X    * More hooks added, to (almost) eliminate GOBJECT-specific
  2728. X        code from the core xlisp fileset:
  2729. X        MODULE_XLOBJ_C_XLOINIT,
  2730. X        MODULE_XLOBJ_C_GLOBALS,
  2731. X        MODULE_XLOBJ_C_CLNEW,
  2732. X        MODULE_XLOBJ_C_OBSYMBOLS
  2733. X
  2734. X    * Renamed xlclass.c to xlhybrid.h
  2735. X
  2736. XThu Nov 22 16:31:11 1990  Jeff Prothero  (jsp at glia)
  2737. X
  2738. X    * Created xlftab.c:funtab_offset().
  2739. X
  2740. XTue Nov 20 11:42:48 1990  Jeff Prothero  (jsp at glia.biostr.washington.edu)
  2741. X
  2742. X    * Per Niels Mayer suggestion, adopted a more systematic
  2743. X    patch-point naming convention:
  2744. X
  2745. X    DECLARING_PRIMITIVE_FUNCTIONS   -> MODULE_XLFTAB_C_GLOBALS
  2746. X    NAMING_PRIMITIVE_FUNCTIONS      -> MODULE_XLFTAB_C_FUNTAB
  2747. X    START_OF_WORLD_INITIALIZATION   -> MODULE_XLINIT_C_XLINIT
  2748. X    END_OF_WORLD_WRAPUP             -> MODULE_XLISP_C_WRAPUP
  2749. X    XLISP_H_MACROS                  -> MODULE_XLISP_H_GLOBALS
  2750. X    XLDMEM_H_MACROS                 -> MODULE_XLDMEM_H_GLOBALS
  2751. X    XLDMEM_H_EXTERNS                -> (combined with above)
  2752. X    XLDMEM_H_NODE_NINFO             -> MODULE_XLDMEM_H_NINFO
  2753. X    REPLACING_BREAKLOOP             -> MODULE_XLDBUG_C_BREAKLOOP_REPLACEMENT
  2754. X    XLDMEM_C_CVFUNS                 -> MODULE_XLDMEM_C_GLOBALS
  2755. X    XLDMEM_C_MARKING_OBJECTS        -> MODULE_XLDMEM_C_GC
  2756. X    XLDMEM_C_MARKING_NEW_NODE_TYPES -> MODULE_XLDMEM_C_MARK
  2757. X    XLDMEM_C_FREEING_NEW_NODE_TYPES -> MODULE_XLDMEM_C_SWEEP
  2758. X    XLDMEM_C_GC_INITIALIZATION      -> MODULE_XLDMEM_C_XLMINIT
  2759. X    XLGLOB_C_VARS                   -> MODULE_XLGLOB_C_GLOBALS
  2760. X    XLIMAGE_C_WRITING_VECTOR        -> MODULE_XLIMAGE_C_XLISAVE
  2761. X    XLIMAGE_C_READING_VECTOR        -> MODULE_XLIMAGE_C_XLIRESTORE
  2762. X    XLIMAGE_C_FREEING_VECTOR        -> MODULE_XLIMAGE_C_FREEIMAGE
  2763. X    XLINIT_C_VARS                   -> MODULE_XLINIT_C_GLOBALS
  2764. X    XLINIT_C_SYMBOLS                -> MODULE_XLINIT_C_XLSYMBOLS
  2765. X    XLPRIN_C_EXTERNS                -> MODULE_XLPRIN_C_GLOBALS
  2766. X    XLPRIN_C_PRINTING_NEW_NODE_TYPES-> MODULE_XLPRIN_C_XLPRINT
  2767. X    XLSYS_C_EXTERNS                 -> MODULE_XLSYS_C_GLOBALS
  2768. X    XLSYS_C_RETURNING_TYPE_SYMBOL   -> MODULE_XLSYS_C_XTYPE
  2769. X  
  2770. X
  2771. XMon Nov 19 15:23:33 1990  Jeff Prothero  (jsp at glia.biostr.washington.edu)
  2772. X
  2773. X    * Added GETENV primitive: xosenvget() in unixstuff, line in xlftab.c.
  2774. X
  2775. XSun Nov 18 13:23:07 1990  Jeff Prothero  (jsp at glia.biostr.washington.edu)
  2776. X
  2777. X    * Added PROVIDE_GOBJECT.  (Objects with LVAL vector and byte vector.)
  2778. X          This required minor patches to xlisp.h, xldmem.h, xlftab.c
  2779. X          xlobj.c and xwinterp.h, all marked with "#ifdef PROVIDE_GOBJECT".
  2780. X          (Also required gobject.h, a new hybrid-class file, and
  2781. X          gobject.c, with support function.)
  2782. X
  2783. XSat Nov 17 12:24:04 1990  Jeff Prothero  (jsp at glia.biostr.washington.edu)
  2784. X
  2785. X    * Collected the old "#ifdef WINTERP" patches in xwinterp.h
  2786. X
  2787. X    * hybrid.h file documenting use of below.
  2788. X
  2789. X    * xlclass.c support for hybrid classes:
  2790. X          DECLARING_PRIMITIVE_FUNCTIONS   "#include" in xlftab.c
  2791. X          NAMING_PRIMITIVE_FUNCTIONS      "#include" in xlftab.c:funtab[]
  2792. X          START_OF_WORLD_INITIALIZATION   "#include" in xlinit.c:xlinit()
  2793. X          END_OF_WORLD_WRAPUP             "#include" in xlisp.c:wrapup()
  2794. X          XLISP_H_MACROS                  "#include" in xlisp.h
  2795. X          XLDMEM_H_MACROS                 "#include" in xldmem.h
  2796. X          XLDMEM_H_NODE_NINFO             "#include" in xldmem.h ninfo union
  2797. X          XLDMEM_H_EXTERNS                "#include" in xldmem.h
  2798. X          REPLACING_BREAKLOOP             "#include" in xldbug.c
  2799. X          XLDMEM_C_CVFUNS                 "#include" in xldmem.c
  2800. X          XLDMEM_C_MARKING_OBJECTS        "#include" in xldmem.c:gc()
  2801. X          XLDMEM_C_MARKING_NEW_NODE_TYPES "#include" in xldmem.c:mark()
  2802. X          XLDMEM_C_FREEING_NEW_NODE_TYPES "#include" in xldmem.c:sweep()
  2803. X          XLDMEM_C_GC_INITIALIZATION      "#include" in xldmem.c:xlminit()
  2804. X          XLGLOB_C_VARS                   "#include" in xlglob.c
  2805. X          XLIMAGE_C_WRITING_VECTOR        "#include" in xlimage.c:xlisave()
  2806. X          XLIMAGE_C_READING_VECTOR        "#include" in xlimage.c:xlirestore()
  2807. X          XLIMAGE_C_FREEING_VECTOR        "#include" in xlimage.c:freeimage()
  2808. X          XLINIT_C_VARS                   "#include" in xlinit.c
  2809. X          XLINIT_C_SYMBOLS                "#include" in xlinit.c:xlsymbols()
  2810. X          XLPRIN_C_EXTERNS                "#include" in xlprin.c
  2811. X          XLPRIN_C_PRINTING_NEW_NODE_TYPES"#include" in xlprin.c:xlprint()
  2812. X          XLSYS_C_EXTERNS                 "#include" in xlsys.c
  2813. X          XLSYS_C_RETURNING_TYPE_SYMBOL   "#include" in xlsys.c:xtype()
  2814. X
  2815. XFri Nov 16 11:06:08 1990  Jeff Prothero  (jsp at glia.biostr.washington.edu)
  2816. X
  2817. X    * Have xldmem.c:xlminit() check that NULL==0, since newvector() &tc
  2818. X          depend on this.
  2819. X
  2820. XThu Nov 15 21:08:20 1990  Jeff Prothero  (jsp at glia.biostr.washington.edu)
  2821. X
  2822. X    * xlread.c:pname(): Changed    xlerror("zero length name");
  2823. X      to                xlfail( "zero length name");
  2824. X
  2825. XSat Nov 10 00:09:23 1990  Jeff Prothero  (jsp at glia.biostr.washington.edu)
  2826. X
  2827. X    * xleval.c:xlevalenv() is never called. #ifdef'ed out.
  2828. X
  2829. X    * xlisp.h defines TRUE and FALSE only if undefined.
  2830. X
  2831. X    * xlftab.c: xbisubr(),xbifsubr() don't exist, deleted them.
  2832. X
  2833. XFri Nov  9 15:16:03 1990  Jeff Prothero  (jsp at glia.biostr.washington.edu)
  2834. X
  2835. X    * unixstuff.c, xlisp.c: renamed oserror() to xoserror to avoid
  2836. X      conflict with system SGI unix oserror fn.
  2837. X
  2838. X    * unixstuff.c/osrand() had "&" where "%" was intended.
  2839. X
  2840. END_OF_FILE
  2841. if test 8739 -ne `wc -c <'src/xlisp/xcore/c/ChangeLog'`; then
  2842.     echo shar: \"'src/xlisp/xcore/c/ChangeLog'\" unpacked with wrong size!
  2843. fi
  2844. # end of 'src/xlisp/xcore/c/ChangeLog'
  2845. fi
  2846. if test -f 'src/xlisp/xcore/c/xldmem.h' -a "${1}" != "-c" ; then 
  2847.   echo shar: Will not clobber existing file \"'src/xlisp/xcore/c/xldmem.h'\"
  2848. else
  2849. echo shar: Extracting \"'src/xlisp/xcore/c/xldmem.h'\" \(9492 characters\)
  2850. sed "s/^X//" >'src/xlisp/xcore/c/xldmem.h' <<'END_OF_FILE'
  2851. X/* -*-C-*-
  2852. X********************************************************************************
  2853. X*
  2854. X* File:         xldmem.h
  2855. X* RCS:          $Header: xldmem.h,v 1.7 89/11/25 05:22:56 mayer Exp $
  2856. X* Description:  dynamic memory definitions
  2857. X* Author:       David Michael Betz; Niels Mayer
  2858. X* Created:      
  2859. X* Modified:     Sat Nov 25 05:22:46 1989 (Niels Mayer) mayer@hplnpm
  2860. X* Language:     C
  2861. X* Package:      N/A
  2862. X* Status:       X11r4 contrib tape release
  2863. X*
  2864. X* WINTERP 1.0 Copyright 1989 Hewlett-Packard Company (by Niels Mayer).
  2865. X* XLISP version 2.1, Copyright (c) 1989, by David Betz.
  2866. X*
  2867. X* Permission to use, copy, modify, distribute, and sell this software and its
  2868. X* documentation for any purpose is hereby granted without fee, provided that
  2869. X* the above copyright notice appear in all copies and that both that
  2870. X* copyright notice and this permission notice appear in supporting
  2871. X* documentation, and that the name of Hewlett-Packard and David Betz not be
  2872. X* used in advertising or publicity pertaining to distribution of the software
  2873. X* without specific, written prior permission.  Hewlett-Packard and David Betz
  2874. X* make no representations about the suitability of this software for any
  2875. X* purpose. It is provided "as is" without express or implied warranty.
  2876. X*
  2877. X* HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  2878. X* SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  2879. X* IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  2880. X* INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  2881. X* LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  2882. X* OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  2883. X* PERFORMANCE OF THIS SOFTWARE.
  2884. X*
  2885. X* See ./winterp/COPYRIGHT for information on contacting the authors.
  2886. X* 
  2887. X* Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  2888. X* Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  2889. X*
  2890. X********************************************************************************
  2891. X*/
  2892. X
  2893. X
  2894. X/* small fixnum range */
  2895. X#define SFIXMIN        (-128)
  2896. X#define SFIXMAX        255
  2897. X#define SFIXSIZE    384
  2898. X
  2899. X/* character range */
  2900. X#define CHARMIN        0
  2901. X#define CHARMAX        255
  2902. X#define CHARSIZE    256
  2903. X
  2904. X/* new node access macros */
  2905. X#define ntype(x)    ((x)->n_type)
  2906. X
  2907. X/* cons access macros */
  2908. X#define car(x)        ((x)->n_car)
  2909. X#define cdr(x)        ((x)->n_cdr)
  2910. X#define rplaca(x,y)    ((x)->n_car = (y))
  2911. X#define rplacd(x,y)    ((x)->n_cdr = (y))
  2912. X
  2913. X/* symbol access macros */
  2914. X#define getvalue(x)     ((x)->n_vdata[0])
  2915. X#define setvalue(x,v)     ((x)->n_vdata[0] = (v))
  2916. X#define getfunction(x)     ((x)->n_vdata[1])
  2917. X#define setfunction(x,v) ((x)->n_vdata[1] = (v))
  2918. X#define getplist(x)     ((x)->n_vdata[2])
  2919. X#define setplist(x,v)     ((x)->n_vdata[2] = (v))
  2920. X#define getpname(x)     ((x)->n_vdata[3])
  2921. X#define setpname(x,v)     ((x)->n_vdata[3] = (v))
  2922. X#define SYMSIZE        4
  2923. X
  2924. X/* closure access macros */
  2925. X#define getname(x)         ((x)->n_vdata[0])
  2926. X#define setname(x,v)       ((x)->n_vdata[0] = (v))
  2927. X#define gettype(x)        ((x)->n_vdata[1])
  2928. X#define settype(x,v)      ((x)->n_vdata[1] = (v))
  2929. X#define getargs(x)         ((x)->n_vdata[2])
  2930. X#define setargs(x,v)       ((x)->n_vdata[2] = (v))
  2931. X#define getoargs(x)        ((x)->n_vdata[3])
  2932. X#define setoargs(x,v)      ((x)->n_vdata[3] = (v))
  2933. X#define getrest(x)         ((x)->n_vdata[4])
  2934. X#define setrest(x,v)       ((x)->n_vdata[4] = (v))
  2935. X#define getkargs(x)        ((x)->n_vdata[5])
  2936. X#define setkargs(x,v)      ((x)->n_vdata[5] = (v))
  2937. X#define getaargs(x)        ((x)->n_vdata[6])
  2938. X#define setaargs(x,v)      ((x)->n_vdata[6] = (v))
  2939. X#define getbody(x)         ((x)->n_vdata[7])
  2940. X#define setbody(x,v)       ((x)->n_vdata[7] = (v))
  2941. X#define xlgetenv(x)    ((x)->n_vdata[8])
  2942. X#define setenv(x,v)    ((x)->n_vdata[8] = (v))
  2943. X#define getfenv(x)    ((x)->n_vdata[9])
  2944. X#define setfenv(x,v)    ((x)->n_vdata[9] = (v))
  2945. X#define getlambda(x)    ((x)->n_vdata[10])
  2946. X#define setlambda(x,v)    ((x)->n_vdata[10] = (v))
  2947. X#define CLOSIZE        11
  2948. X
  2949. X/* vector access macros */
  2950. X#define getsz(x)    ((x)->n_vsize)
  2951. X#define getelement(x,i)    ((x)->n_vdata[i])
  2952. X#define setelement(x,i,v) ((x)->n_vdata[i] = (v))
  2953. X
  2954. X/* object access macros */
  2955. X#define getclass(x)    ((x)->n_vdata[0])
  2956. X#define getivar(x,i)    ((x)->n_vdata[i+1])
  2957. X#define setivar(x,i,v)    ((x)->n_vdata[i+1] = (v))
  2958. X
  2959. X/* subr/fsubr access macros */
  2960. X#define getsubr(x)    ((x)->n_subr)
  2961. X#define getoffset(x)    ((x)->n_offset)
  2962. X
  2963. X/* fixnum/flonum/char access macros */
  2964. X#define getfixnum(x)    ((x)->n_fixnum)
  2965. X#define getflonum(x)    ((x)->n_flonum)
  2966. X#define setflonum(x, val)  (x)->n_flonum = (val) /* Voodoo */
  2967. X#define getchcode(x)    ((x)->n_chcode)
  2968. X
  2969. X/* string access macros */
  2970. X#define getstring(x)    ((x)->n_string)
  2971. X#define getslength(x)    ((x)->n_strlen)
  2972. X
  2973. X/* file stream access macros */
  2974. X#define getfile(x)    ((x)->n_fp)
  2975. X#define setfile(x,v)    ((x)->n_fp = (v))
  2976. X#define getsavech(x)    ((x)->n_savech)
  2977. X#define setsavech(x,v)    ((x)->n_savech = (v))
  2978. X
  2979. X/* unnamed stream access macros */
  2980. X#define gethead(x)    ((x)->n_car)
  2981. X#define sethead(x,v)    ((x)->n_car = (v))
  2982. X#define gettail(x)    ((x)->n_cdr)
  2983. X#define settail(x,v)    ((x)->n_cdr = (v))
  2984. X
  2985. X/* node types */
  2986. X#define FREE    0
  2987. X#define SUBR    1
  2988. X#define FSUBR    2
  2989. X#define CONS    3
  2990. X#define SYMBOL    4
  2991. X#define FIXNUM    5
  2992. X#define FLONUM    6
  2993. X#define STRING    7
  2994. X#define OBJECT    8
  2995. X#define STREAM    9
  2996. X#define VECTOR    10
  2997. X#define CLOSURE    11
  2998. X#define CHAR    12
  2999. X#define USTREAM    13
  3000. X#define STRUCT    14
  3001. X
  3002. X/* Left the n_type definitions here rather */
  3003. X/* than moving them to xwinterp.h and      */
  3004. X/* gobject.h because inadvertent collisions*/
  3005. X/* would be a disaster.                    */
  3006. X#ifdef PROVIDE_WINTERP
  3007. X#define XLTYPE_XtAccelerators        15
  3008. X#define XLTYPE_XtTranslations        16
  3009. X#define XLTYPE_XtCallbackList        17
  3010. X#define XLTYPE_XEvent            18
  3011. X#define XLTYPE_Window            19
  3012. X#define XLTYPE_Pixel            20
  3013. X#define XLTYPE_Pixmap            21
  3014. X#define XLTYPE_XImage                   22
  3015. X#define XLTYPE_XmString            23
  3016. X#define XLTYPE_XmFontList        24
  3017. X#define XLTYPE_caddr_t            25 /* generic pointer */
  3018. X#define XLTYPE_XT_RESOURCE              26
  3019. X#define XLTYPE_CALLBACKOBJ              27
  3020. X#define XLTYPE_TIMEOUTOBJ               28
  3021. X#define XLTYPE_PIXMAP_REFOBJ        29
  3022. X#define XLTYPE_WIDGETOBJ                30
  3023. X#define XLTYPE_EVHANDLEROBJ        31
  3024. X#endif
  3025. X#ifdef PROVIDE_XGBJ
  3026. X/* Pick a number well away from the winterp progression, */
  3027. X/* but not large enough to invite signed-char bugs:      */
  3028. X#define GOBJECT    (97)
  3029. X#endif
  3030. X
  3031. X
  3032. X
  3033. X/* subr/fsubr node */
  3034. X#define n_subr        n_info.n_xsubr.xs_subr
  3035. X#define n_offset    n_info.n_xsubr.xs_offset
  3036. X  
  3037. X/* cons node */
  3038. X#define n_car        n_info.n_xcons.xc_car
  3039. X#define n_cdr        n_info.n_xcons.xc_cdr
  3040. X
  3041. X/* fixnum node */
  3042. X#define n_fixnum    n_info.n_xfixnum.xf_fixnum
  3043. X
  3044. X/* flonum node */
  3045. X#define n_flonum    n_info.n_xflonum.xf_flonum
  3046. X/* character node */
  3047. X#define n_chcode    n_info.n_xchar.xc_chcode
  3048. X
  3049. X/* string node */
  3050. X#define n_string    n_info.n_xstring.xs_string
  3051. X#define n_strlen    n_info.n_xstring.xs_length
  3052. X
  3053. X/* stream node */
  3054. X#define n_fp        n_info.n_xstream.xs_fp
  3055. X#define n_savech    n_info.n_xstream.xs_savech
  3056. X
  3057. X/* vector/object node */
  3058. X#define n_vsize        n_info.n_xvector.xv_size
  3059. X#define n_vdata        n_info.n_xvector.xv_data
  3060. X
  3061. X/* node structure */
  3062. Xtypedef struct node {
  3063. X    char n_type;        /* type of node */
  3064. X    char n_flags;        /* flag bits */
  3065. X    union ninfo {         /* value */
  3066. X
  3067. X    struct xsubr {        /* subr/fsubr node */
  3068. X        struct node *(*xs_subr)();    /* function pointer */
  3069. X        int xs_offset;        /* offset into funtab */
  3070. X    } n_xsubr;
  3071. X    struct xcons {        /* cons node */
  3072. X        struct node *xc_car;    /* the car pointer */
  3073. X        struct node *xc_cdr;    /* the cdr pointer */
  3074. X    } n_xcons;
  3075. X    struct xfixnum {    /* fixnum node */
  3076. X        FIXTYPE xf_fixnum;        /* fixnum value */
  3077. X    } n_xfixnum;
  3078. X    struct xflonum {    /* flonum node */
  3079. X        FLOTYPE xf_flonum;        /* flonum value */
  3080. X    } n_xflonum;
  3081. X    struct xchar {        /* character node */
  3082. X        int xc_chcode;        /* character code */
  3083. X    } n_xchar;
  3084. X    struct xstring {    /* string node */
  3085. X        int xs_length;        /* string length */
  3086. X        unsigned char *xs_string;    /* string pointer */
  3087. X    } n_xstring;
  3088. X    struct xstream {     /* stream node */
  3089. X        FILE *xs_fp;        /* the file pointer */
  3090. X        int xs_savech;        /* lookahead character */
  3091. X    } n_xstream;
  3092. X    struct xvector {    /* vector/object/symbol/structure node */
  3093. X        int xv_size;        /* vector size */
  3094. X        struct node **xv_data;    /* vector data */
  3095. X    } n_xvector;
  3096. X/* Include hybrid-class functions: *//* JSP */
  3097. X#define MODULE_XLDMEM_H_NINFO
  3098. X#include "../../xmodules.h"
  3099. X#undef MODULE_XLDMEM_H_NINFO
  3100. X
  3101. X    } n_info;
  3102. X} *LVAL;
  3103. X
  3104. X/* memory segment structure definition */
  3105. Xtypedef struct segment {
  3106. X    int sg_size;
  3107. X    struct segment *sg_next;
  3108. X    struct node sg_nodes[1];
  3109. X} SEGMENT;
  3110. X
  3111. X/* memory allocation functions */
  3112. Xextern LVAL cons();        /* (cons x y) */
  3113. Xextern LVAL cvsymbol();           /* convert a string to a symbol */
  3114. Xextern LVAL cvstring();           /* convert a string */
  3115. Xextern LVAL cvfile();        /* convert a FILE * to a file */
  3116. Xextern LVAL cvsubr();        /* convert a function to a subr/fsubr */
  3117. Xextern LVAL cvfixnum();           /* convert a fixnum */
  3118. Xextern LVAL cvflonum();           /* convert a flonum */
  3119. Xextern LVAL cvchar();        /* convert a character */
  3120. X
  3121. Xextern LVAL newstring();    /* create a new string */
  3122. Xextern LVAL newvector();    /* create a new vector */
  3123. Xextern LVAL newobject();    /* create a new object */
  3124. Xextern LVAL newclosure();    /* create a new closure */
  3125. Xextern LVAL newustream();    /* create a new unnamed stream */
  3126. Xextern LVAL newstruct();    /* create a new structure */
  3127. X
  3128. Xextern LVAL s_self,k_new,k_isnew; /* Symbol SELF, keywords :ISNEW :NEW *//*JSP*/
  3129. Xextern LVAL cls_class,cls_object; /* Class objects for CLASS and OBJECT*//*JSP*/
  3130. X
  3131. X/* Include hybrid-class functions: *//* JSP */
  3132. X#define MODULE_XLDMEM_H_GLOBALS
  3133. X#include "../../xmodules.h"
  3134. X#undef MODULE_XLDMEM_H_GLOBALS
  3135. X
  3136. X
  3137. X
  3138. END_OF_FILE
  3139. if test 9492 -ne `wc -c <'src/xlisp/xcore/c/xldmem.h'`; then
  3140.     echo shar: \"'src/xlisp/xcore/c/xldmem.h'\" unpacked with wrong size!
  3141. fi
  3142. # end of 'src/xlisp/xcore/c/xldmem.h'
  3143. fi
  3144. echo shar: End of archive 3 \(of 16\).
  3145. cp /dev/null ark3isdone
  3146. MISSING=""
  3147. for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 ; do
  3148.     if test ! -f ark${I}isdone ; then
  3149.     MISSING="${MISSING} ${I}"
  3150.     fi
  3151. done
  3152. if test "${MISSING}" = "" ; then
  3153.     echo You have unpacked all 16 archives.
  3154.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  3155. else
  3156.     echo You still need to unpack the following archives:
  3157.     echo "        " ${MISSING}
  3158. fi
  3159. ##  End of shell archive.
  3160. exit 0
  3161.